想在多线上面随意点一点实现增加节点？

bingshuier

就是想用通用的函数实现！

spp_wall

(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)
)

bingshuier

spp_wall 发表于 2014-8-5 15:22
(defun C:zjxdd (/ EN OBJ PT PP)
  (if (and (setq EN (entsel "\n选择多选线: "))
           (setq EN ...

非常感谢！！

bingshuier

香田里浪人 发表于 2014-8-5 15:57
;;;;;;;多段线加点
(defun c:jd (/ ent p obj n pp pn newv)
  (if (setq ent (entsel "\n点取多线段:")) ...

非常感谢！！

yoyoho

感谢 spp_wall 与 香田里浪人 分享程序!

fengche1915@