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!!

2 comentários em “Mais polilinhas”

  1. 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

Deixe um comentário

Carrinho de compras
Rolar para cima