ucuc2003 发表于 2015-8-11 11:32:32

源码学习 改对象颜色，改对象图层颜色

本帖最后由 ucuc2003 于 2015-8-17 13:42 编辑

http://bbs.mjtd.com/thread-169058-1-1.html
源码学习： 改对象颜色，改对象图层颜色（在阿甘大侠的源码基础上修改增加功能）
核心代码：再次鸣谢原作者 阿甘
;改颜色随层程序
(defun GL:gssc(/ ss)
(princ "颜色改为随层")
(while (setq ss (ssget))
    (princ (strcat (itoa (sslength ss)) "个对象的颜色改为随层"))
    (command "change" ss "" "P" "C" "bylayer" "")
);while
)

;改对象颜色程序
(defun GL:gdxys (dxys / en i obj ss)
(while (setq ss (ssget ":s"))
   (princ (strcat "共改变了<" (itoa (sslength ss)) ">个对象的颜色"))
   (command "change" ss "" "p" "c" dxys "")
);while
(princ)
)

;改图层颜色程序
(defun GL:gtcys (yanse / acaddoc acadobj en i lay layobj obj ss vlay vlay1)
(setq AcadObj (vlax-get-Acad-object)
            AcadDoc (vla-get-ActiveDocument AcadObj)
            LayObj (vla-get-layers AcadDoc)
)
(if (setq ss (ssget))
   (progn
    (setq i 0)
    (repeat (sslength ss)
   (setq en (ssname ss i);取图元名
         obj (vlax-ename->vla-object en);转换图元
         lay (vla-get-layer obj);图层名
         vlay (vla-item LayObj lay);转为VL图层名
   )
   (if (= (equal vlay vlay1) nil)
      (progn
       (vla-put-color vlay yanse);改图层颜色
       (setq vlay1 vlay)
   ))
   (setq i (1+ i))
    )
   ))
(princ)
)

zhangcan0515 发表于 2022-11-4 19:34:47

太强了，自己写的不能弹出颜色对话框。只能框选手工添加颜色号，楼主发了源码，可以学习一下，然后修改自己的代码。谢谢

wen5913205 发表于 2021-5-30 17:58:46

我觉得，不要跳那个面板出来更好，直接在命令行中选颜色数字。
有谁能再改一下不？

1361878068 发表于 2023-4-25 10:28:02

改图层颜色那个还是很猛的

429014673 发表于 2015-8-11 12:11:58

搞得太复杂了，CAD原配的还是很好用的。

lucas_3333 发表于 2015-8-11 12:49:04

好熟悉的界面， 好像阿甘发过

qyming 发表于 2015-8-11 12:50:26

回复看贴

ucuc2003 发表于 2015-8-11 13:04:41

本帖最后由 ucuc2003 于 2015-8-11 13:10 编辑

lucas_3333 发表于 2015-8-11 12:49 static/image/common/back.gif
好熟悉的界面， 好像阿甘发过
嗯，在他的基础上修改添加了功能

nadaloveluna 发表于 2015-8-11 13:20:34

恩，阿甘的那个我一直在用，很好的。也谢谢楼主的改进。

长风（尚品） 发表于 2015-8-11 13:36:55

路过，看看确实强

用户3766035971 发表于 2015-8-11 16:30:22

路过，看看确实强

海盗曹 发表于 2015-8-12 13:06:29

看看学习一下

USER2128 发表于 2015-8-12 14:38:57

非常感谢楼主分享源码！
页: [1] 2 3 4 5 6 7 8
查看完整版本: 源码学习 改对象颜色，改对象图层颜色