cjjh8301 发表于 2020-11-6 10:54:04

继承画多段线

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


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

start4444 发表于 2020-11-6 10:54:05

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

香远益清 发表于 2020-11-6 13:59:37

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

被承包的东子 发表于 2020-11-6 14:08:50

(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 发表于 2020-11-7 10:04:41

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

664571221 发表于 2022-3-20 14:47:47

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


你好提示有错误

被承包的东子 发表于 2022-3-23 09:45:34

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

什么错误啊

pengfei2010 发表于 2022-8-24 20:55:01

感谢楼主的分享
页: [1]
查看完整版本: 继承画多段线