想在多线上面随意点一点实现增加节点？
本帖最后由 bingshuier 于 2014-8-5 09:42 编辑就是想用通用的函数实现！ (defun C:zjxdd (/ EN OBJ PT PP)
(if (and (setq EN (entsel "\n选择多选线: "))
(setq EN (car EN))
(sssetfirst nil (ssadd EN))
(setq OBJ (vlax-ename->vla-object EN))
(or (= (vla-get-objectname OBJ) "AcDbPolyline")
(and (princ "\n所选的对象不是多段线。") nil)
)
)
(while (setq PT (getpoint "\n指定新顶点: "))
(setq PT (trans PT 1 0)
PP (vlax-curve-getclosestpointto OBJ PT))
(vlax-invoke
OBJ
'ADDVERTEX
(1+ (fix (vlax-curve-getparamatpoint OBJ PP)))
(list (car PT) (cadr PT))
)
)
)
(sssetfirst)
(princ)
) ;;;;;;;多段线加点
(defun c:jd (/ ent p obj n pp pn newv)
(if (setq ent (entsel "\n点取多线段:"))
(progn
(setq p (cadr ent))
(setq obj (vlax-ename->vla-object (car ent)))
(setq pp (vlax-curve-getclosestpointto obj (trans p 1 0)))
(setq n (fix (vlax-curve-getparamatpoint obj pp)))
(setq pn p)
(while (setq pn (getpoint pn "\n输入要加点的位置: "))
(command "undo" "be")
(setq pn (trans pn 1 (car ent)))
(setq pn (list (car pn) (cadr pn)))
(setq newv (vlax-safearray-fill
(vlax-make-safearray vlax-vbDouble '(0 . 1))
pn
)
)
(vla-addvertex obj (1+ n) newv)
(command "undo" "e")
)
)
)
(princ)
) spp_wall 发表于 2014-8-5 15:22 static/image/common/back.gif
(defun C:zjxdd (/ EN OBJ PT PP)
(if (and (setq EN (entsel "\n选择多选线: "))
(setq EN ...
非常感谢！！ 香田里浪人 发表于 2014-8-5 15:57 static/image/common/back.gif
;;;;;;;多段线加点
(defun c:jd (/ ent p obj n pp pn newv)
(if (setq ent (entsel "\n点取多线段:")) ...
非常感谢！！ 感谢 spp_wall 与 香田里浪人 分享程序!
页:
[1]