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!!
Tenho, mande-me um email:
neyton@yahoo.com
Olá Neyton,
vc tem alguma rotina que simplifique uma POLYLINE, removendo *automaticamente* vértices?
ex: de 100 vértices ela passaria a ter 75 ou 50 sem eu ter que escolher os vértices a serem removidos. Estou com problemas em aplicar alguns LINETYPE em POLYLINEs com muitos vertices, nem o 'Linetype Generation = Enable' nem o LTSCALE resolveram.
[]s