增加多段线顶点

Lisphk · 发表于 2021-1-19 09:31:56

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun c:addvertex (/ ent i nlst obj p pt x)
(vl-load-com)
(while (setq ent (entsel "\nSelect point on polyline to add vertex: "))
(if (and ent (= (cdr (assoc 0 (entget (car ent)))) "LWPOLYLINE"))
(progn (setq i (fix (vlax-curve-getparamatpoint
(car ent)
(setq p (vlax-curve-getclosestpointto (car ent) (cadr ent)))
)
)
obj (vlax-ename->vla-object (car ent))
pt (vlax-curve-getpointatparam (car ent) i)
nlst nil
)
(mapcar '(lambda (x)
(if (equal x (list 10 (car pt) (cadr pt)) 0.0001)
(setq nlst (cons x nlst)
nlst (cons (list 10 (car p) (cadr p)) nlst)
)
(setq nlst (cons x nlst))
)
)
(entget (car ent))
)
(entmod (reverse nlst))
(entupd (car ent))
(sssetfirst nil (ssadd (car ent)))
)
)
)
(sssetfirst nil)
(princ)
)

(defun c:addvertex (/ ent i nlst obj p pt x) 
  (vl-load-com) 
  (while (setq ent (entsel "\nSelect point on polyline to add vertex: ")) 
    (if        (and ent (= (cdr (assoc 0 (entget (car ent)))) "LWPOLYLINE")) 
      (progn (setq i        (fix (vlax-curve-getparamatpoint 
                               (car ent) 
                               (setq p (vlax-curve-getclosestpointto (car ent) (cadr ent))) 
                             ) 
                        ) 
                   obj        (vlax-ename->vla-object (car ent)) 
                   pt        (vlax-curve-getpointatparam (car ent) i) 
                   nlst        nil 
             ) 
             (mapcar '(lambda (x) 
                        (if (equal x (list 10 (car pt) (cadr pt)) 0.0001) 
                          (setq        nlst (cons x nlst) 
                                nlst (cons (list 10 (car p) (cadr p)) nlst) 
                          ) 
                          (setq nlst (cons x nlst)) 
                        ) 
                      ) 
                     (entget (car ent)) 
             ) 
             (entmod (reverse nlst)) 
             (entupd (car ent)) 
             (sssetfirst nil (ssadd (car ent))) 
      ) 
    ) 
  ) 
  (sssetfirst nil) 
  (princ) 
)

yuren008 · 发表于 2021-1-19 10:01:18

做个对论坛有益的人。

chen7560152 · 发表于 2021-8-7 16:02:54

学习了，有用

mojianxing · 发表于 2023-12-22 15:48:20

学习了，有用

账号		自动登录	找回密码
密码			立即注册

[每日一码] 增加多段线顶点

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。