唯寻 发表于 2016-2-20 14:06:20

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

本帖最后由 唯寻 于 2016-2-20 18:16 编辑

想通过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))
)
)
)

唯寻 发表于 2022-3-28 10:20:08

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

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

唯寻 发表于 2020-6-23 16:39:30

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

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

李钊伟2012 发表于 2022-2-14 16:43:37

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

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

(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 "A")(N5-changelayercolor LAYER 1))
    ((= layer "B")(N5-changelayercolor LAYER 2))
    ((= "WALL" (substr layer (-(strlen layer)3)))(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)
    )

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

陈进佳 发表于 2016-2-20 16:37 static/image/common/back.gif


一个明经币都没有，亏了

唯寻 发表于 2016-2-20 17:50:51

陈进佳 发表于 2016-2-20 16:41 static/image/common/back.gif
一个明经币都没有，亏了

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

唯寻 发表于 2016-2-20 17:58:02

陈进佳 发表于 2016-2-20 16:41 static/image/common/back.gif
一个明经币都没有，亏了

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

陈进佳 发表于 2016-2-20 22:33:21

唯寻 发表于 2016-2-20 17:58 static/image/common/back.gif
佳佳，运行不下去
参数值错误: 正 0

你改了代码？

唯寻 发表于 2016-2-20 23:01:26

本帖最后由 唯寻 于 2016-2-20 23:03 编辑

是啊      

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

陈进佳 发表于 2016-2-20 22:33 static/image/common/back.gif
你改了代码？


嗯找了张图 改后试了了一下
(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-21 07:39:19

唯寻 发表于 2016-2-20 23:04 static/image/common/back.gif


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

陈进佳 发表于 2016-2-21 08:02:08

用这个吧，之前有点问题(DEFUN N5-changelayercolor (layer co)
(vla-put-color
    (vla-Item (vla-get-Layers
                (vla-get-ActiveDocument (vlax-get-acad-object))
              )
              layer
    )
    co
)
)
(defun N5-get-layers (/ lst a)
(SETQ LST (LIST (CDADR (tblnext "layer" t))))
(while (setq a (cdadr (tblnext "layer")))
    (setq lst (cons a lst))
)
lst
)
(defun c:qq (/ LST LAYER)                ;把"A"，"B"改成自己想要的，带WALL的图层注意要大小写
(vl-load-com)
(SETQ LST (N5-GET-LAYERS))
(FOREACH LAYER LST
    (cond
      ((= layer "0") (N5-changelayercolor LAYER 1))
      ((= layer "JZD") (N5-changelayercolor LAYER 5))
      ((and (>= (strlen layer) 4);这句别动
          (= "WALL" (substr layer (- (strlen layer) 3)));这句别动
       )
       (N5-changelayercolor LAYER 255)
      )
    )
)
(PRIN1)
)
页: [1] 2 3
查看完整版本: 忽略图层前缀或者后缀，自动修改图层颜色