Mais polilinhas

Como eu disse, mais polilinhas!! Na edição de LWPOLYLINEs, principalmente daquelas que representam poligonais, muitas vezes precisamos excluir alguns vértices, por um motivo qualquer e muitas pessoas simplesmente sobrepõe um vértice a outro... tá funciona, mas não é lá uma solução muito elegante, não concordam?? a rotina a seguir faz isso: apaga vértices da polilinha, apenas clicando-a próximo ao vertice a ser removido quero ver!!

(defun c:dvert  (/ tmp d pts d2 pt n lst pr b ent vla sw ew pts2)
  (tbn:error-init '(("cmdecho" 0 "osmode" 0) t))
  (while (progn
           (if (> (length lst) 0)
             (initget "U" 0))
           (setq tmp
                  (entsel
                    (strcat
     "\nSelecione a polilinha a eliminar o vertice (proximo ao vertice a ser eliminado)"
                      (if (> (length lst) 0) " [Undo]"  ""))))
           (or tmp (/= 52 (getvar "errno"))))
    (if (= "U" tmp)
      (progn
        (setq tmp (car lst)
              lst (cdr lst))
        (entmod tmp)
        (entupd (dxf -1 tmp)))
      (if (if tmp (wcmatch (dxf 0 (car tmp)) "*POLYLINE"))
        (progn
          (setq ent (car tmp)
                pts (get-points-polig ent))
          (if (> (length pts) 2)
            (progn
              (setq pr  (trans (cadr tmp) 1 0)
                    n   0
                    b   nil
                    vla (vlax-ename->vla-object ent)
                    d   1e30
                    lst (cons (entget ent) lst))
              (sssetfirst nil (ssadd ent (ssadd)))
              (if (= "LWPOLYLINE" (dxf 0 ent))
                (repeat (length pts)
                  (vla-GetWidth vla n 'sw 'ew)
                  (setq b (cons (list (vla-getbulge vla n) sw ew) b)
                        n (1+ n))))
              (setq n 0)
              (foreach x  pts
                (if (< (setq d2 (distance pr x)) d)
                  (setq d  d2
                        pt n))
                (setq n (1+ n)))
              (setq pts2
                     (apply 'append
                            (if (= "LWPOLYLINE" (dxf 0 ent))
                              (mapcar '(lambda (x) (remove-n 2 x))
                                      (remove-n pt pts))
                              (remove-n pt pts))))
              (vla-put-coordinates
                (vlax-ename->vla-object (car tmp))
                (vlax-safearray-fill
                  (vlax-make-safearray
                    vlax-vbdouble
                    (cons 0 (1- (length pts2))))
                  pts2))
              (setq n 0)
              (if (= "LWPOLYLINE" (dxf 0 ent))
                (foreach x  (remove-n pt (reverse b))
                  (vla-setbulge vla n (car x))
                  (vla-setwidth vla n (cadr x) (caddr x))
                  (setq n (1+ n)))))
            (prompt "\nNão é possível deixar apenas um vértice"))))))
  (sssetfirst nil nil)
  (tbn:error-restore t))

---

Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, dxf, get-points-polig, remove-n, tbn:error-restore

depois posto uma que INCLUI vértices, é bem bacana!!