便捷式查看、修改图层颜色的编程申请

zhuqiqing · 发表于 2016-12-13 01:09:31

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

   画图时，经常要修改图层颜色等属性，通常做法是：先在图中选中对象，在图层工具行查看颜色等属性后，再打开图层对话框找到相应图层后，再点击颜色等进入颜色选择框改变图层颜色。此做法在图层很多时极不便捷。
编程要求及步聚：1. 先选择对象（可包括各种对象类型，如线、多段线、样条线、文字、属性、嵌套块内的实体等）；
                              2. 选择对象后，直接调出修改颜色的面板对话框，选择其中一个颜色点击确认；
                              3.  确认后，所选对象的图层颜色相应修改。

iLisp · 发表于 2016-12-13 11:39:37

(defun c:tt (/ e col lyr)
(while (and (setq e (car (entsel "\nPick Entity: ")))
(setq col (acad_truecolordlg '(62 . 255)))
)
(setq lyr (cdr (assoc 8 (entget e))))
(vla-put-color
(vla-item (vla-get-layers
(vla-get-activedocument (vlax-get-acad-object))
)
lyr
)
(cdr (assoc 62 col))
)
)
(princ)
)

newer · 发表于 2016-12-13 02:26:25

没太看明白，

你意思是选择一个对象，根据这个对象的颜色，修改这个对象所在层的颜色和对象颜色一样？

如果这样，那还打开颜色对话框做什么呢？

Lisphk · 发表于 2016-12-13 11:44:20

iLisp 发表于 2016-12-13 11:39

设置过的图层是不是要过滤下，避免重复设置同一个层？

iLisp · 发表于 2016-12-13 11:57:07

Lisphk 发表于 2016-12-13 11:44

随时设，可以后悔啊！

Lisphk · 发表于 2016-12-13 12:01:27

iLisp 发表于 2016-12-13 11:57

看代码，可以循环选择实体，只看实体不知道图层，就怕点10个实体，9个是同一个层的，是不是效率就不高了，或者设置过的图层，图层所有实体都亮显下。想重设就再点，不重设也能避免了。另外，设置了图层颜色，是不是点的实体颜色设置为随层？

zhuqiqing · 发表于 2016-12-13 16:05:59

newer 发表于 2016-12-13 02:26

是楼下ilisp理解的那样.

zhuqiqing · 发表于 2016-12-13 16:08:26

Lisphk 发表于 2016-12-13 12:01

刚运行了代码，是这个需求。但当实体颜色不是随层时，修改图层的颜色时最好能同时改为随层，这样会更便捷！

iLisp · 发表于 2016-12-14 09:38:07

完善了程序，支持真彩色和配色系统

(defun c:tt (/ e el l lyr col lyr l accm cl)
(while
(and (setq e (car (entsel "\nPick Entity: ")))
(setq el (entget e))
(setq lyr (cdr (assoc 8 el)))
(setq l (entget (tblobjname "layer" lyr)))
(cond
((assoc 430 l)
(setq col (acad_truecolordlg (assoc 430 l) nil))
)
((assoc 420 l)
(setq col (acad_truecolordlg (assoc 420 l) nil))
)
(t
(setq col (acad_truecolordlg (assoc 62 l) nil))
)
)
)
(cond
((assoc 430 col)
(setq accm (vla-GetInterfaceObject
(vlax-get-acad-object)
(strcat "AutoCAD.AcCmColor."
(itoa (atoi (getvar "acadver")))
)
)
)
(vla-setnames accm (cdr (assoc 430 col)))
(vla-put-truecolor
(vla-item (vla-get-layers
(vla-get-activedocument (vlax-get-acad-object))
)
lyr
)
accm
)
)
((assoc 420 col)
(setq accm (vla-GetInterfaceObject
(vlax-get-acad-object)
(strcat "AutoCAD.AcCmColor."
(itoa (atoi (getvar "acadver")))
)
)
cl (xd::color:long->rgb (cdr (assoc 420 col)))
)
(vla-put-colormethod accm acColorMethodByRGB)
(vla-setrgb accm (car cl) (cadr cl) (caddr cl))
(vla-put-truecolor
(vla-item (vla-get-layers
(vla-get-activedocument (vlax-get-acad-object))
)
lyr
)
accm
)
)
(t
(vla-put-color
(vla-item (vla-get-layers
(vla-get-activedocument (vlax-get-acad-object))
)
lyr
)
(cdr (assoc 62 col))
)
)
)
(entmod (append el '((62 . 256))))
)
(princ)
)

(defun c:tt (/ e el l lyr col lyr l accm cl) 
  (while 
    (and (setq e (car (entsel "\nPick Entity: "))) 
         (setq el (entget e)) 
         (setq lyr (cdr (assoc 8 el))) 
         (setq l (entget (tblobjname "layer" lyr))) 
         (cond 
           ((assoc 430 l) 
            (setq col (acad_truecolordlg (assoc 430 l) nil)) 
           ) 
           ((assoc 420 l) 
            (setq col (acad_truecolordlg (assoc 420 l) nil)) 
           ) 
           (t 
            (setq col (acad_truecolordlg (assoc 62 l) nil)) 
           ) 
         ) 
    ) 
     (cond 
       ((assoc 430 col) 
        (setq accm (vla-GetInterfaceObject 
                     (vlax-get-acad-object) 
                     (strcat "AutoCAD.AcCmColor." 
                             (itoa (atoi (getvar "acadver"))) 
                     ) 
                   ) 
 
        ) 
        (vla-setnames accm (cdr (assoc 430 col))) 
        (vla-put-truecolor 
          (vla-item (vla-get-layers 
                      (vla-get-activedocument (vlax-get-acad-object)) 
                    ) 
                    lyr 
          ) 
          accm 
        ) 
       ) 
       ((assoc 420 col) 
        (setq accm (vla-GetInterfaceObject 
                     (vlax-get-acad-object) 
                     (strcat "AutoCAD.AcCmColor." 
                             (itoa (atoi (getvar "acadver"))) 
                     ) 
                   ) 
              cl   (xd::color:long->rgb (cdr (assoc 420 col))) 
        ) 
        (vla-put-colormethod accm acColorMethodByRGB) 
        (vla-setrgb accm (car cl) (cadr cl) (caddr cl)) 
        (vla-put-truecolor 
          (vla-item (vla-get-layers 
                      (vla-get-activedocument (vlax-get-acad-object)) 
                    ) 
                    lyr 
          ) 
          accm 
        ) 
       ) 
       (t 
        (vla-put-color 
          (vla-item (vla-get-layers 
                      (vla-get-activedocument (vlax-get-acad-object)) 
                    ) 
                    lyr 
          ) 
          (cdr (assoc 62 col)) 
        ) 
       ) 
     ) 
     (entmod (append el '((62 . 256)))) 
  ) 
  (princ) 
)

zhuqiqing · 发表于 2016-12-14 15:17:00

iLisp 发表于 2016-12-14 09:38

非常感谢！好用

sunshinejwt · 发表于 2016-12-20 20:57:02

试过了，确实是把图层的颜色给改了。就是没有让其他的同一层的颜色随层。

yufeng37 · 发表于 2020-9-9 14:27:47

非常好用@ilsp

afrgrgfdgdgt111 · 发表于 2021-2-23 13:43:42

iLisp 发表于 2016-12-13 11:39

非常感谢您，这个改图层很好用，之前win7用
(defun c:yy (/ layname ent2 a)
(Setq layname (Vlax-Get (Vlax-Ename->Vla-Object (car (nentsel))) 'Layer ))
(setq ent2 (entget(tblobjname "layer" layname)))
(setq a (acad_colordlg 256))
(setq ent2 (subst (cons 62 a) (assoc 62 ent2) ent2))
(entmod ent2)
(princ)
)
之前win7用的上面的代码改图层颜色，现在win10不知道为什么不能用了，用的你的非常好用

账号		自动登录	找回密码
密码			立即注册

[编程申请] 便捷式查看、修改图层颜色的编程申请

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。