忽略图层前缀或者后缀，自动修改图层颜色

唯寻

想通过lisp实现以下功能：
把名称为“*A”的图层，颜色改成索引颜色为“1”红色  ;  名称为“*B”的图层，颜色改成索引颜色为“2”黄色………
把名称为“*WALL”的颜色变为索引颜色的“255"号色，其中“*”代表任意前缀”
--比如带外部参照的图层“地下一层|WALL”、“首层|WALL”、“二层|WALL”、“平面$0$WALL”
也就是说能忽略一些前缀或者后缀，只按图层中的关键字来过滤图层，之后设定为需要的颜色
当调用程序后，直接把现有图纸上的图层，按设定的规则，全部处理完。

自己借用了 http://bbs.mjtd.com/thread-93873-1-1.html 贴中 SuperliuC 给的lisp 但能力有限 还是没办法实现。
求助大家 向达人学习

(defun c:tc()
(vl-load-com)
(setq acmCol (vla-getinterfaceobject
           (vlax-get-acad-object)  (strcat "AutoCAD.AcCmColor." (substr (getvar "ACADVER") 1 2))))
(vlax-for x (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
  (cond
    ((= (vla-get-name x) "A") (vla-setrgb acmCol 1) (vla-put-Color x acmCol))
    ((= (vla-get-name x) "B") (vla-setrgb acmCol 2) (vla-put-Color x acmCol))
    ((= (vla-get-name x) "*WALL") (vla-setrgb acmCol 255) (vla-put-Color x acmCol))
    ((= (vla-get-name x) "WALL") (vla-setrgb acmCol 255) (vla-put-Color x acmCol))
  )
  )
  )

唯寻

664571221 发表于 2022-3-10 18:26
这个功能的用途是啥呀楼主

我后来用其他命令搞定了。
可以实现一键处理外部参照，只要外部参照都是颜色随层，可以一键冻结不需要的图层，把对应图层修改为指定颜色，设置不打印层等。对于本单位内部标准图非常省事。如果是外单位制图不标准的用处不大

唯寻

l452002882 发表于 2018-11-10 11:28
大师，求一个忽略图层前缀，修改图层线型的程序，我出50rmb

看帖子有点儿晚了……
我后来用的CAD得图层命令，大大提高了速度，并且命令特别简单。你还需要吗

李钊伟2012

(command "layer"  "c" 1 "*BEAM*,*S_主梁*" "")     为啥简单的代码能实现，要搞那么复杂。

陈进佳

1. (defun c:qq(/ a b b1 b2);把"A"，"B"改成自己想要的，带WALL的图层注意要大小写
   
2.   (vl-load-com)
   
3.   (tblnext "layer" t )
   
4. (while
   
5.   (setq enda(tblnext "layer" ))
   
6.   (setq layer(cdadr ENDA))
   
7.   (cond
   
8.     ((= layer "A")(N5-changelayercolor LAYER 1))
   
9.     ((= layer "B")(N5-changelayercolor LAYER 2))
   
10.     ((= "WALL" (substr layer (-(strlen layer)3)))(N5-changelayercolor LAYER 255))
    
11.     )
    
12.   )
    
13.   )
    
14. (DEFUN N5-changelayercolor(layer co)
    
15.     (vla-put-color (vla-Item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) layer) co)
    
16.     )

(defun c:qq(/ a b b1 b2);把"A"，"B"改成自己想要的，带WALL的图层注意要大小写<br />   (vl-load-com)<br />   (tblnext "layer" t )<br /> (while<br />   (setq enda(tblnext "layer" ))<br />   (setq layer(cdadr ENDA))<br />   (cond<br />     ((= layer "A")(N5-changelayercolor LAYER 1))<br />     ((= layer "B")(N5-changelayercolor LAYER 2))<br />     ((= "WALL" (substr layer (-(strlen layer)3)))(N5-changelayercolor LAYER 255))<br />     )<br />   )<br />   )<br /> (DEFUN N5-changelayercolor(layer co)<br />     (vla-put-color (vla-Item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) layer) co)<br />     )

陈进佳

陈进佳 发表于 2016-2-20 16:37

一个明经币都没有，亏了

唯寻

陈进佳 发表于 2016-2-20 16:41
一个明经币都没有，亏了

哎，唯一的一买别人的代码了，等我有了一定给你

唯寻

陈进佳 发表于 2016-2-20 16:41
一个明经币都没有，亏了

佳佳，运行不下去
参数值错误: 正 0   

陈进佳

唯寻 发表于 2016-2-20 17:58
佳佳，运行不下去
参数值错误: 正 0

你改了代码？

唯寻

是啊      

唯寻

陈进佳 发表于 2016-2-20 22:33
你改了代码？

嗯  找了张图 改后试了了一下 (defun c:qq(/ a b b1 b2);把"A"，"B"改成自己想要的，带WALL的图层注意要大小写   (vl-load-com)   (tblnext "layer" t ) (while   (setq enda(tblnext "layer" ))   (setq layer(cdadr ENDA))   (cond     ((= layer "DOTA")(N5-changelayercolor LAYER 251))     ((= layer "ROOM")(N5-changelayercolor LAYER 1))     ((= "WALL" (substr layer (-(strlen layer)255)))(N5-changelayercolor LAYER 255))     )   )   ) (DEFUN N5-changelayercolor(layer co)     (vla-put-color (vla-Item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) layer) co)     ) 执行之后 QQ 参数值错误: 正 -246

陈进佳

唯寻 发表于 2016-2-20 23:04

(= "WALL" (substr layer (-(strlen layer)3)))；这里的3别动行吗，就知道你瞎改了

陈进佳

用这个吧，之前有点问题

1. (DEFUN N5-changelayercolor (layer co)
   
2.   (vla-put-color
   
3.     (vla-Item (vla-get-Layers
   
4.                 (vla-get-ActiveDocument (vlax-get-acad-object))
   
5.               )
   
6.               layer
   
7.     )
   
8.     co
   
9.   )
   
10. )
    
11. (defun N5-get-layers (/ lst a)
    
12.   (SETQ LST (LIST (CDADR (tblnext "layer" t))))
    
13.   (while (setq a (cdadr (tblnext "layer")))
    
14.     (setq lst (cons a lst))
    
15.   )
    
16.   lst
    
17. )
    
18. (defun c:qq (/ LST LAYER)                ;把"A"，"B"改成自己想要的，带WALL的图层注意要大小写
    
19.   (vl-load-com)
    
20.   (SETQ LST (N5-GET-LAYERS))
    
21.   (FOREACH LAYER LST
    
22.     (cond
    
23.       ((= layer "0") (N5-changelayercolor LAYER 1))
    
24.       ((= layer "JZD") (N5-changelayercolor LAYER 5))
    
25.       ((and (>= (strlen layer) 4);这句别动
    
26.             (= "WALL" (substr layer (- (strlen layer) 3)));这句别动
    
27.        )
    
28.        (N5-changelayercolor LAYER 255)
    
29.       )
    
30.     )
    
31.   )
    
32.   (PRIN1)
    
33. )

(DEFUN N5-changelayercolor (layer co)<br />   (vla-put-color<br />     (vla-Item (vla-get-Layers<br />                 (vla-get-ActiveDocument (vlax-get-acad-object))<br />               )<br />               layer<br />     )<br />     co<br />   )<br /> )<br /> (defun N5-get-layers (/ lst a)<br />   (SETQ LST (LIST (CDADR (tblnext "layer" t))))<br />   (while (setq a (cdadr (tblnext "layer")))<br />     (setq lst (cons a lst))<br />   )<br />   lst<br /> )<br /> (defun c:qq (/ LST LAYER)                ;把"A"，"B"改成自己想要的，带WALL的图层注意要大小写<br />   (vl-load-com)<br />   (SETQ LST (N5-GET-LAYERS))<br />   (FOREACH LAYER LST<br />     (cond<br />       ((= layer "0") (N5-changelayercolor LAYER 1))<br />       ((= layer "JZD") (N5-changelayercolor LAYER 5))<br />       ((and (>= (strlen layer) 4);这句别动<br />             (= "WALL" (substr layer (- (strlen layer) 3)));这句别动<br />        )<br />        (N5-changelayercolor LAYER 255)<br />       )<br />     )<br />   )<br />   (PRIN1)<br /> )