继承画多段线

cjjh8301

为了省那一步操作，10币还是值得的


要求如下，输入命令，回车，选择图元，然后画多段线，多段线同选择的图元同层同色，如果选择的图元也是直线或者多段线，则画出的多段线同层同色同线型，命令结束后当前图层不能变！
辛苦大师们了！

start4444

(defun c:tt5 (/ en p)
(setq en (car (entsel "\n选择对象:")))
(command "PLINE" (setq p (getpoint"\n>>>选点:")) (while (setq p (getpoint"\n>>>选点:" p)) (command p)) "MATCHPROP" en (entlast) "")
)

香远益清

楼上start4444的程序段完全满足楼主要求

被承包的东子

(defun c:cs()
(vl-load-com)
(setq en0 (car (entsel "\n选择基础对象：")))
(setq en0_obj (vlax-Ename->Vla-Object en0))
(setq name   (vla-get-ObjectName en0_obj))
  (setq obj_col (vla-get-Color en0_obj)obj_lay (vla-get-Layer en0_obj)obj_typ (vla-get-Linetype en0_obj))
(setq pt1 (getpoint "\n开始绘制Pline线:"))
(command "_pline" pt1 pause)
   (if (or (eq name "AcDbPolyline") (eq name "AcDbLine"))
       (Put-Layer-color-type  (entlast) obj_lay obj_col obj_typ)
       (Put-Layer-color  (entlast) obj_lay obj_col)
  )
(princ)
)
(defun Put-Layer-color-type (en lay col ltype)
(setq obj (vlax-Ename->Vla-Object en))
  (if (vlax-write-enabled-p obj)
    (progn
      (vla-put-Color obj col)
      (vla-put-layer obj lay)
      (vla-put-Linetype obj ltype)
    )
  )
)
(defun Put-Layer-color (en lay col)
(setq obj (vlax-Ename->Vla-Object en))
  (if (vlax-write-enabled-p obj)
    (progn
      (vla-put-Color obj col)
      (vla-put-layer obj lay)
    )
  )
)

czb203

楼上start4444的程序段完全满足楼主要求

664571221

被承包的东子 发表于 2020-11-6 14:08
(defun c:cs()
(vl-load-com)
(setq en0 (car (entsel "\n选择基础对象：")))

你好提示有错误

被承包的东子

664571221 发表于 2022-3-20 14:47
你好提示有错误

什么错误啊

pengfei2010

感谢楼主的分享