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

ucuc2003

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

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

wen5913205

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

1361878068

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

429014673

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

lucas_3333

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

qyming

回复看贴

ucuc2003

lucas_3333 发表于 2015-8-11 12:49
好熟悉的界面， 好像阿甘发过

嗯，在他的基础上修改添加了功能

nadaloveluna

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

长风（尚品）

路过，看看确实强

用户3766035971

路过，看看确实强

海盗曹

看看学习一下

USER2128

非常感谢楼主分享源码！