社区 › AutoLISP/Visual LISP 编程技术 › 求助：求在已有多义线上接着画的代码

清风明月名字 发表于 2013-9-20 23:45:54

求助：求在已有多义线上接着画的代码

请问，我已经画了一条直线型的多义线，但中途中断了，如何接着画呢？也就 是说接着画是同一条线，而不是两条多义线

13648893846 发表于 2017-11-2 19:52:18

edata 发表于 2014-1-12 22:02
你试试。

大神程序挺好,能否完善图片中功能

vladimir 发表于 2017-11-7 10:16:59

不错的资料，谢谢分享啊。

yoyoho 发表于 2017-11-7 12:53:00

感谢诸位分享程序!!!!

gdslqs 发表于 2013-9-21 00:48:08

可以找到已经画好的pl线的各个顶点，以你想继续画的点为最后点排序，重新调用pline命令画线，画到你希望开始的点就用pause结束，就可以继续画了

清风明月名字 发表于 2013-9-21 09:18:12

就这样将就解决了这个问题
(defun C:紧接着直线型轻多义线A的后面画A (/ ent PLTYPE obj vtx vtxlst n ptlst)
    (vl-load-com)
    (setq ent (entsel "\n选取多线:\n"))
    (if ent
      (progn
          (setq PLTYPE (cdr (assoc 0 (entget (car ent)))))
          (if (or (= "POLYLINE" PLTYPE) (= "LWPOLYLINE" PLTYPE))
            (progn
               (setq obj (vlax-ename->vla-object (car ent)))
               (setq vtx (vla-get-Coordinates obj))
               (setq vtxlst (vlax-safearray->list (vlax-variant-value vtx)))
               (setq n 0)
               (setq ptlst nil)

                (repeat (/ (length vtxlst) 2)
                         (setq ptlst (append ptlst (list (list (nth n vtxlst) (nth (1+ n) vtxlst)))))
                         (setq n (+ n 2))
               )
               (if ptlst
(PROGN
(command "erase" ent "")
(command "_PLINE")
(mapcar 'command ptlst)
(command PAUSE)

)



                   nil)
             )
             (prompt "\n选取实体不是多义线!")
          );if
       )      
   );if
)

emk 发表于 2013-9-21 09:19:36

但中途中断了
是怎么个中断法，是中断后马上再次执行pl还是中断过程中有过其他操作？

清风明月名字 发表于 2013-9-21 09:21:47

有其它操作

清风明月名字 发表于 2013-9-21 09:24:05

我将就型地解决了，解决的代码见上帖。如果能在下面的代码基础上解决，更好


(defun C:TT (/ 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)
)

dbx511 发表于 2013-12-27 12:32:23

能不能使接着画的多义线的切线方向和选择的那条多义线的点的切线方向一样阿？谢谢？同时，如果选择的那条多义线的弧段能不能不要被修改成直线段阿？谢谢

llsheng_73 发表于 2013-12-31 09:27:14

dbx511 发表于 2013-12-27 12:32 static/image/common/back.gif
能不能使接着画的多义线的切线方向和选择的那条多义线的点的切线方向一样阿？谢谢？同时，如果选择的那条多 ...

要想达到你的要求应该好好研究下南方CASS的自由续接命令，如果能想明白它是怎么做的，应该也能做得出来的，不过应该不简单

edata 发表于 2014-1-1 23:10:51

这个接着最后一点画线，感觉"像"pl命令。对于闭合线可能不是正确的结果。(defun C:TT (/ EN OBJ PT PP END_PT N N_PT )
(defun HH:GetCurveNum (obj)
(if (vlax-curve-isClosed obj)
    (fix (1- (vlax-curve-getendParam obj)))
    (fix (vlax-curve-getendParam obj))
)
)
(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)
         )
      )
    (progn
    (setq end_pt(vlax-curve-getEndPoint OBJ))   
    (while (if end_pt (setq PT (getpoint end_pt "\n指定新顶点: ")) (setq PT (getpoint "\n指定新顶点: ")))
      (setq PT (trans PT 1 0)
            ;PP (vlax-curve-getclosestpointto OBJ PT)
          pp (vlax-3d-point pt)
          )
      (setq N(HH:GetCurveNum obj))
      
       (setq n_pt(vlax-safearray-fill
         (vlax-make-safearray vlax-vbdouble '(0 . 1))
         (list(car pt)(cadr pt))
         ))
      (vla-addvertex obj (1+ n) n_pt )
      (setq end_pt(vlax-curve-getEndPoint OBJ))
    )
    )
)
(sssetfirst)
(princ)
)

llsheng_73 发表于 2014-1-4 12:05:54

清风明月名字 发表于 2013-9-21 09:24 static/image/common/back.gif
我将就型地解决了，解决的代码见上帖。如果能在下面的代码基础上解决，更好




这一个虽然在接着画上有点问题，但在已有线上加点相当方便

查看完整版本: 求助：求在已有多义线上接着画的代码