求一个含关键词的图层改色

yanchao316

现在设计院的图层太多了，图层能整到几百上千个，改图层颜色太反锁了，哪位老师能否帮忙写个将带关键词的图层改色，关键词不用区分大小写，但关键词可能有前缀，或有后缀，或前后缀均有。比如将图层含有Hdrl的关键词改为11号色，
图层含windows的关键词改为4号色，
图层含Dims的关键词改为3号色，
图层含TCH的关键词改为3号色，
图层含wall的关键词改为2号色，
其余的图层均改为251号色。

yshf

;改图层颜色
;图层含windows的关键词改为4号色，
;图层含Dims的关键词改为3号色，
;图层含TCH的关键词改为3号色，
;图层含wall的关键词改为2号色，
;其余的图层均改为251号色。
(defun c:gtcys()
     (vl-load-com)
     (setvar "cmdecho" 0)
     (setq olderr *error*)

     (defun *error*(msg)
         (princ "\n发生错误了 --> ")(princ msg)
         (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
         (setq *error* olderr)
         (setvar "nomutt" 0)
         (setvar "cmdecho" 1)
         (princ)
     )
  
     (mapcar 'setvar xtblm '(0 0))
     (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))

     (setq KeyValue (list '("windows" 4)
                          '("Dims"    3)
                          '("TCH"     3)
                          '("wall"    2)
                    )
     )

     (vlax-for Layer (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object)))
         (setq name (strcase (vlax-get-property Layer "Name") t))
         (setq pdbz nil)
         (mapcar '(lambda(sjb)
                      (mapcar 'set '(Key Value) sjb)
                      (If (wcmatch name (strcat "*" (strcase Key t) "*"))
                          (progn
                              (setq pdbz t)
                              (vlax-put-property Layer "Color" Value)
                          )
                      )
                  )
                  KeyValue
         )
         (if (= pdbz nil)
             (vlax-put-property Layer "Color" 251)
         )
     )
  
     (setq *error* olderr)
     (setvar "cmdecho" 1)
     (princ)
)

yanchao316

yshf 发表于 2021-8-14 20:53
;改图层颜色
;图层含windows的关键词改为4号色，
;图层含Dims的关键词改为3号色，

多谢！很好用。