社区 › AutoLISP/Visual LISP 编程技术 › 一键将所有选择内容更改为251号颜色，含所有块、块内文字、尺寸标志及所有尺寸内容

小毛草 发表于 2025-1-17 13:39:56

一键将所有选择内容更改为251号颜色，含所有块、块内文字、尺寸标志及所有尺寸内容

本帖最后由 小毛草 于 2025-1-22 18:26 编辑

(defun c:ts (/ ss doc blks)
(vl-load-com) ; 加载 ActiveX 支持
(setvar "cmdecho" 0) ; 关闭命令回显

;; 解锁所有图层
(command "layer" "u" "*" "s" "0" "")

;; 获取当前文档和块集合
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq blks (vla-get-blocks doc))

;; 遍历所有块并修改块名为 _archtick 的块颜色
(vlax-for blk blks
    (if (= (vla-get-name blk) "_archtick")
      (vlax-for obj blk
      (vla-put-color obj 251) ; 修改块内对象颜色
      )
    )
)

;; 选择对象
(setq ss (ssget)) ; 选择对象

;; 如果选择集不为空
(if ss
    (progn
      ;; 遍历选择集并修改颜色
      (vlax-for obj (vla-get-ActiveSelectionSet doc)
      (ChColor obj) ; 调用递归函数修改颜色
      )
      ;; 清除选择集
      (vla-delete (vla-get-ActiveSelectionSet doc))
      (princ "\n所有选择对象颜色已修改为 251 号色。")
    )
    (princ "\n未选择到任何对象。")
)
(princ)
)

;; 递归函数：修改对象及其子对象的颜色
(defun ChColor (obj / blkName)
;; 修改当前对象的颜色
(vla-put-color obj 251)

;; 如果是块参照，递归处理块内的对象
(if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
         (setq blkName (vla-get-name obj)))
    (progn
      ;; 递归处理块内对象
      (vlax-for subObj (vla-item blks blkName)
      (ChColor subObj) ; 递归处理块内对象
      )
      ;; 处理块内的属性文字
      (if (= (vla-get-HasAttributes obj) :vlax-true)
      (foreach att (vlax-invoke obj 'GetAttributes)
          (vla-put-color att 251) ; 修改属性文字颜色
      )
      )
    )
)

;; 如果是属性文字，修改颜色
(if (= (vla-get-ObjectName obj) "AcDbAttributeDefinition")
    (vla-put-color obj 251)
)

;; 如果是多行文字或单行文字，修改颜色
(if (wcmatch (vla-get-ObjectName obj) "*Text")
    (vla-put-color obj 251)
)

;; 如果是尺寸标注，修改尺寸线、尺寸文字、尺寸界线等颜色
(if (wcmatch (vla-get-ObjectName obj) "*Dimension")
    (progn
      (vla-put-DimensionLineColor obj 251) ; 尺寸线颜色
      (vla-put-ExtensionLineColor obj 251) ; 尺寸界线颜色
      (vla-put-TextColor obj 251) ; 尺寸文字颜色
    )
)

;; 如果是天正自定义对象，修改颜色
(if (IsTCHObject obj) ; 判断是否为天正自定义对象
    (progn
      (vla-put-color obj 251) ; 修改天正自定义对象颜色
      ;; 如果是天正块参照，递归处理块内对象
      (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
               (setq blkName (vla-get-name obj)))
      (vlax-for subObj (vla-item blks blkName)
          (ChColor subObj) ; 递归处理块内对象
      )
      )
    )
)
)

;; 判断是否为天正自定义对象
(defun IsTCHObject (obj)
;; 天正自定义对象通常以 "TCH_" 开头
(wcmatch (vla-get-ObjectName obj) "*TCH_*")
)

(defun c:ts (/ ss doc blks)
(vl-load-com) ; 加载 ActiveX 支持
(setvar "cmdecho" 0) ; 关闭命令回显

;; 解锁所有图层
(command "layer" "u" "*" "s" "0" "")

;; 获取当前文档和块集合
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq blks (vla-get-blocks doc))

;; 遍历所有块并修改块名为 _archtick 的块颜色
(vlax-for blk blks
    (if (= (vla-get-name blk) "_archtick")
      (vlax-for obj blk
      (vla-put-color obj 251) ; 修改块内对象颜色
      )
    )
)

;; 选择对象
(setq ss (ssget)) ; 选择对象

;; 如果选择集不为空
(if ss
    (progn
      ;; 遍历选择集并修改颜色
      (vlax-for obj (vla-get-ActiveSelectionSet doc)
      (ChColor obj) ; 调用递归函数修改颜色
      )
      ;; 清除选择集
      (vla-delete (vla-get-ActiveSelectionSet doc))
      (princ "\n所有选择对象颜色已修改为 251 号色。")
    )
    (princ "\n未选择到任何对象。")
)
(princ)
)

;; 递归函数：修改对象及其子对象的颜色
(defun ChColor (obj / blkName)
;; 修改当前对象的颜色
(vla-put-color obj 251)

;; 如果是块参照，递归处理块内的对象
(if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
         (setq blkName (vla-get-name obj)))
    (progn
      ;; 递归处理块内对象
      (vlax-for subObj (vla-item blks blkName)
      (ChColor subObj) ; 递归处理块内对象
      )
      ;; 处理块内的属性文字
      (if (= (vla-get-HasAttributes obj) :vlax-true)
      (foreach att (vlax-invoke obj 'GetAttributes)
          (vla-put-color att 251) ; 修改属性文字颜色
      )
      )
    )
)

;; 如果是属性文字，修改颜色
(if (= (vla-get-ObjectName obj) "AcDbAttributeDefinition")
    (vla-put-color obj 251)
)

;; 如果是多行文字或单行文字，修改颜色
(if (wcmatch (vla-get-ObjectName obj) "*Text")
    (vla-put-color obj 251)
)

;; 如果是尺寸标注，修改尺寸线、尺寸文字、尺寸界线等颜色
(if (wcmatch (vla-get-ObjectName obj) "*Dimension")
    (progn
      (vla-put-DimensionLineColor obj 251) ; 尺寸线颜色
      (vla-put-ExtensionLineColor obj 251) ; 尺寸界线颜色
      (vla-put-TextColor obj 251) ; 尺寸文字颜色
    )
)

;; 如果是天正自定义对象，修改颜色
(if (IsTCHObject obj) ; 判断是否为天正自定义对象
    (progn
      (vla-put-color obj 251) ; 修改天正自定义对象颜色
      ;; 如果是天正块参照，递归处理块内对象
      (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
               (setq blkName (vla-get-name obj)))
      (vlax-for subObj (vla-item blks blkName)
          (ChColor subObj) ; 递归处理块内对象
      )
      )
    )
)
)

;; 判断是否为天正自定义对象
(defun IsTCHObject (obj)
;; 天正自定义对象通常以 "TCH_" 开头
(wcmatch (vla-get-ObjectName obj) "*TCH_*")
)

(defun c:ts (/ ss doc blks)
(vl-load-com) ; 加载 ActiveX 支持
(setvar "cmdecho" 0) ; 关闭命令回显

;; 解锁所有图层
(command "layer" "u" "*" "s" "0" "")

;; 获取当前文档和块集合
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq blks (vla-get-blocks doc))

;; 遍历所有块并修改块名为 _archtick 的块颜色
(vlax-for blk blks
    (if (= (vla-get-name blk) "_archtick")
      (vlax-for obj blk
      (vla-put-color obj 251) ; 修改块内对象颜色
      )
    )
)

;; 选择对象
(setq ss (ssget)) ; 选择对象

;; 如果选择集不为空
(if ss
    (progn
      ;; 遍历选择集并修改颜色
      (vlax-for obj (vla-get-ActiveSelectionSet doc)
      (ChColor obj) ; 调用递归函数修改颜色
      )
      ;; 清除选择集
      (vla-delete (vla-get-ActiveSelectionSet doc))
      (princ "\n所有选择对象颜色已修改为 251 号色。")
    )
    (princ "\n未选择到任何对象。")
)
(princ)
)

;; 递归函数：修改对象及其子对象的颜色
(defun ChColor (obj / blkName)
;; 修改当前对象的颜色
(vla-put-color obj 251)

;; 如果是块参照，递归处理块内的对象
(if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
         (setq blkName (vla-get-name obj)))
    (progn
      ;; 递归处理块内对象
      (vlax-for subObj (vla-item blks blkName)
      (ChColor subObj) ; 递归处理块内对象
      )
      ;; 处理块内的属性文字
      (if (= (vla-get-HasAttributes obj) :vlax-true)
      (foreach att (vlax-invoke obj 'GetAttributes)
          (vla-put-color att 251) ; 修改属性文字颜色
      )
      )
    )
)

;; 如果是属性文字，修改颜色
(if (= (vla-get-ObjectName obj) "AcDbAttributeDefinition")
    (vla-put-color obj 251)
)

;; 如果是多行文字或单行文字，修改颜色
(if (wcmatch (vla-get-ObjectName obj) "*Text")
    (vla-put-color obj 251)
)

;; 如果是尺寸标注，修改尺寸线、尺寸文字、尺寸界线等颜色
(if (wcmatch (vla-get-ObjectName obj) "*Dimension")
    (progn
      (vla-put-DimensionLineColor obj 251) ; 尺寸线颜色
      (vla-put-ExtensionLineColor obj 251) ; 尺寸界线颜色
      (vla-put-TextColor obj 251) ; 尺寸文字颜色
    )
)

;; 如果是天正自定义对象，修改颜色
(if (IsTCHObject obj) ; 判断是否为天正自定义对象
    (progn
      (vla-put-color obj 251) ; 修改天正自定义对象颜色
      ;; 如果是天正块参照，递归处理块内对象
      (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
               (setq blkName (vla-get-name obj)))
      (vlax-for subObj (vla-item blks blkName)
          (ChColor subObj) ; 递归处理块内对象
      )
      )
    )
)
)

;; 判断是否为天正自定义对象
(defun IsTCHObject (obj)
;; 天正自定义对象通常以 "TCH_" 开头
(wcmatch (vla-get-ObjectName obj) "*TCH_*")
)

(defun c:ts (/ ss doc blks)
(vl-load-com) ; 加载 ActiveX 支持
(setvar "cmdecho" 0) ; 关闭命令回显


;; 解锁所有图层
(command "layer" "u" "*" "s" "0" "")


;; 获取当前文档和块集合
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq blks (vla-get-blocks doc))


;; 遍历所有块并修改块名为 _archtick 的块颜色
(vlax-for blk blks
    (if (= (vla-get-name blk) "_archtick")
      (vlax-for obj blk
      (vla-put-color obj 251) ; 修改块内对象颜色
      )
    )
)


;; 选择对象
(setq ss (ssget)) ; 选择对象


;; 如果选择集不为空
(if ss
    (progn
      ;; 遍历选择集并修改颜色
      (vlax-for obj (vla-get-ActiveSelectionSet doc)
      (ChColor obj) ; 调用递归函数修改颜色
      )
      ;; 清除选择集
      (vla-delete (vla-get-ActiveSelectionSet doc))
      (princ "\n所有选择对象颜色已修改为 251 号色。")
    )
    (princ "\n未选择到任何对象。")
)
(princ)
)


;; 递归函数：修改对象及其子对象的颜色
(defun ChColor (obj / blkName)
;; 修改当前对象的颜色
(vla-put-color obj 251)


;; 如果是块参照，递归处理块内的对象
(if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
         (setq blkName (vla-get-name obj)))
    (progn
      ;; 递归处理块内对象
      (vlax-for subObj (vla-item blks blkName)
      (ChColor subObj) ; 递归处理块内对象
      )
      ;; 处理块内的属性文字
      (if (= (vla-get-HasAttributes obj) :vlax-true)
      (foreach att (vlax-invoke obj 'GetAttributes)
          (vla-put-color att 251) ; 修改属性文字颜色
      )
      )
    )
)


;; 如果是属性文字，修改颜色
(if (= (vla-get-ObjectName obj) "AcDbAttributeDefinition")
    (vla-put-color obj 251)
)


;; 如果是多行文字或单行文字，修改颜色
(if (wcmatch (vla-get-ObjectName obj) "*Text")
    (vla-put-color obj 251)
)


;; 如果是尺寸标注，修改尺寸线、尺寸文字、尺寸界线等颜色
(if (wcmatch (vla-get-ObjectName obj) "*Dimension")
    (progn
      (vla-put-DimensionLineColor obj 251) ; 尺寸线颜色
      (vla-put-ExtensionLineColor obj 251) ; 尺寸界线颜色
      (vla-put-TextColor obj 251) ; 尺寸文字颜色
    )
)


;; 如果是天正自定义对象，修改颜色
(if (IsTCHObject obj) ; 判断是否为天正自定义对象
    (progn
      (vla-put-color obj 251) ; 修改天正自定义对象颜色
      ;; 如果是天正块参照，递归处理块内对象
      (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
               (setq blkName (vla-get-name obj)))
      (vlax-for subObj (vla-item blks blkName)
          (ChColor subObj) ; 递归处理块内对象
      )
      )
    )
)
)


;; 判断是否为天正自定义对象
(defun IsTCHObject (obj)
;; 天正自定义对象通常以 "TCH_" 开头
(wcmatch (vla-get-ObjectName obj) "*TCH_*")
)

小毛草 发表于 2025-1-17 14:05:34

本帖最后由 小毛草 于 2025-1-25 11:20 编辑

应该可以框选的，我这边用2016是可以框选多个进行选择的,还可以用下面这个一键恢复原有颜色！可以试一下！
(defun c:s11 (/ ss doc blks)
(vl-load-com) ; 加载 ActiveX 支持
(setvar "cmdecho" 0) ; 关闭命令回显

;; 获取当前文档和块集合
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
      blks (vla-get-blocks doc))

;; 提示用户选择对象
(princ "选择对象颜色随层: ")
(setq ss (ssget)) ; 选择对象

;; 如果选择集不为空
(if ss
    (progn
      ;; 遍历选择集并修改颜色为随层
      (vlax-for obj (vla-get-ActiveSelectionSet doc)
      (ChColorToByLayer obj) ; 调用递归函数修改颜色
      )
      ;; 清除选择集
      (vla-delete (vla-get-ActiveSelectionSet doc))
      (princ "\n所有选择对象颜色已修改为随层。")
    )
    (princ "\n未选择到任何对象。")
)
(setvar "cmdecho" 1)
(princ)
)

;; 递归函数：修改对象及其子对象的颜色为随层
(defun ChColorToByLayer (obj / blkName)
;; 修改当前对象的颜色为随层
(vla-put-Color obj 256) ; 256 是 ByLayer 的颜色索引

;; 如果是块参照，递归处理块内的对象
(if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
         (setq blkName (vla-get-name obj)))
    (progn
      ;; 递归处理块内对象
      (vlax-for subObj (vla-item blks blkName)
      (ChColorToByLayer subObj) ; 递归处理块内对象
      )
      ;; 处理块内的属性文字
      (if (= (vla-get-HasAttributes obj) :vlax-true)
      (foreach att (vlax-invoke obj 'GetAttributes)
          (vla-put-Color att 256) ; 修改属性文字颜色为随层
      )
      )
    )
)

;; 如果是属性文字，修改颜色为随层
(if (= (vla-get-ObjectName obj) "AcDbAttributeDefinition")
    (vla-put-Color obj 256)
)

;; 如果是多行文字或单行文字，修改颜色为随层
(if (wcmatch (vla-get-ObjectName obj) "*Text")
    (vla-put-Color obj 256)
)

;; 如果是尺寸标注，修改尺寸线、尺寸文字、尺寸界线等颜色为随层
(if (wcmatch (vla-get-ObjectName obj) "*Dimension")
    (progn
      (vla-put-DimensionLineColor obj 256) ; 尺寸线颜色为随层
      (vla-put-ExtensionLineColor obj 256) ; 尺寸界线颜色为随层
      (vla-put-TextColor obj 4) ; 尺寸文字颜色为随层
    )
)
)
;;;改对象颜色为以图层颜色为线形颜色

shujh1989 发表于 2025-1-22 16:29:58

本帖最后由 shujh1989 于 2025-1-22 16:31 编辑

sky899150 发表于 2025-1-17 14:53
对天正的那个标高图元不起作用
天正标高是要修改天正文字的颜色。
(if (and
                (= (vlax-get-property obj 'ObjectName) "TDbSymbElevation" )
                (vlax-property-available-p obj 'TextLayer) ; 检查TextLayer属性是否存在
               (wcmatch (vlax-get-property obj 'Layer) "*DIM_ELEV*" ))
      (vlax-put-property obj 'TextColor 256)
   )

小毛草 发表于 2025-1-17 16:13:27

惜惜2 发表于 2025-1-17 15:38
块中块不支持啊，属性赋值也不行

应该可以吧，我试了2016是可以的！

mequan 发表于 2025-1-17 13:57:03

试用了一下，发现不能框选多个进行修改，只能点选

qazxswk 发表于 2025-1-17 14:21:14

试试修改多重引线。

sky899150 发表于 2025-1-17 14:53:49

对天正的那个标高图元不起作用

小毛草 发表于 2025-1-17 15:21:44

不一定支持天正文件格式，我这边不用天正！

惜惜2 发表于 2025-1-17 15:38:24

块中块不支持啊，属性赋值也不行

惜惜2 发表于 2025-1-17 17:07:05

小毛草 发表于 2025-1-17 16:13
应该可以吧，我试了2016是可以的！

属性的值不行

cghdy 发表于 2025-1-20 14:11:19

同名块也会被修改颜色，建议遍历块时将要修改的块改下名再改颜色

查看完整版本: 一键将所有选择内容更改为251号颜色，含所有块、块内文字、尺寸标志及所有尺寸内容