转发 改块的颜色

345205680

;;改块的颜色

(defun c:ChBlkColor (/ ChBlkColor SS blks I Obj BnLst)
  (defun ChBlkColor (Blks Obj Color / BlkName oName)
    (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
             (= (vla-get-HasAttributes obj) :vlax-true)
        )
      (foreach x (vlax-invoke obj 'getattributes)
        (vla-put-color x Color)
      )
    )
    (setq BlkName (vla-get-name obj))
    (if (not (member BlkName bnlst))
      (progn
        (setq bnlst (cons BlkName BnLst))
        (vlax-for X (vla-item Blks BlkName)
          (setq oName (vla-get-ObjectName X))
          (cond ((wcmatch oName "*Dimension,AcDbLeader,AcDbFcf")
                 (vla-put-DimensionLineColor X Color)
                 (if (wcmatch oName "*Dimension")
                   (progn
                     (vla-put-ExtensionLineColor X Color)
                     (if (setq BlkName (assoc 2 (entget (vlax-vla-object->ename X))))
                       (vlax-for X (vla-item Blks (cdr BlkName))
                         (vla-put-color X Color)
                       )
                     )
                   )
                 )
                 (if (wcmatch oName "*Dimension,AcDbFcf")
                   (vla-put-TextColor X Color)
                 )
                )
                ((= oName "AcDbBlockReference")
                 (ChBlkColor Blks X Color)
                )
          )
          (vla-put-color X Color)
        )
      )
    )
    (vla-UpDate obj)
  )
  (if (and (setq ss (ssget '((0 . "insert"))))
           (or $ChBlkColor$ (setq $ChBlkColor$ 7))
           (setq $ChBlkColor$ (acad_colordlg $ChBlkColor$))
      )
    (progn
      (setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
      (repeat (setq i (sslength ss))
        (setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
        (ChBlkColor Blks Obj $ChBlkColor$)
      )
    )
  )
  (princ)
)

lxl304712346

(defun c:ChBlkColor (/ ChBlkColor SS blks I Obj BnLst)
  ;; 定义一个命令级别的函数 ChBlkColor，允许从 AutoCAD 命令行调用
  (defun ChBlkColor (Blks Obj Color / BlkName oName)
    ;; 定义一个内部递归函数 ChBlkColor，用于处理块的颜色和图层设置
    (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference") ;; 检查对象是否为块引用
             (= (vla-get-HasAttributes obj) :vlax-true))       ;; 检查块是否包含属性
      (foreach x (vlax-invoke obj 'getattributes)              ;; 遍历块的所有属性
        (vla-put-color x Color)                                ;; 设置属性的颜色
        (if (not (= (vla-get-layer x) "0"))                    ;; 如果属性的图层不是 "0"
          (vla-put-layer x "0")                                ;; 将属性的图层设置为 "0"
        )
      )
    )
    (setq BlkName (vla-get-name obj))                          ;; 获取块的名称
    (if (not (member BlkName bnlst))                           ;; 如果块名称不在已处理的列表中
      (progn
        (setq bnlst (cons BlkName BnLst))                      ;; 将块名称添加到已处理列表中
        (vlax-for X (vla-item Blks BlkName)                    ;; 遍历块中的所有对象
          (setq oName (vla-get-ObjectName X))                  ;; 获取对象的名称
          (cond
            ((wcmatch oName "*Dimension,AcDbLeader,AcDbFcf")   ;; 如果对象是尺寸、引线或填充字符
              (vla-put-DimensionLineColor X Color)             ;; 设置尺寸线颜色
              (if (wcmatch oName "*Dimension")                 ;; 如果对象是尺寸
                (progn
                  (vla-put-ExtensionLineColor X Color)         ;; 设置延伸线颜色
                  (if (setq BlkName (assoc 2 (entget (vlax-vla-object->ename X)))) ;; 获取尺寸关联的块名称
                    (vlax-for X (vla-item Blks (cdr BlkName)) ;; 遍历关联块中的所有对象
                      (vla-put-color X Color)                 ;; 设置对象颜色
                      (if (not (= (vla-get-layer X) "0"))     ;; 如果对象的图层不是 "0"
                        (vla-put-layer X "0")                 ;; 将对象的图层设置为 "0"
                      )
                    )
                  )
                )
              )
              (if (wcmatch oName "*Dimension,AcDbFcf")         ;; 如果对象是尺寸或填充字符
                (vla-put-TextColor X Color)                    ;; 设置文字颜色
              )
            )
            ((= oName "AcDbBlockReference")                    ;; 如果对象是块引用
              (ChBlkColor Blks X Color)                        ;; 递归调用 ChBlkColor 处理嵌套块
            )
            (t                                                ;; 处理其他类型的对象
              (vla-put-color X Color)                          ;; 设置对象颜色
              (if (not (= (vla-get-layer X) "0"))             ;; 如果对象的图层不是 "0"
                (vla-put-layer X "0")                          ;; 将对象的图层设置为 "0"
              )
            )
          )
        )
      )
    )
    ;; 处理动态块
    (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference") ;; 检查对象是否为块引用
             (vlax-property-available-p obj 'DynamicBlock))    ;; 检查块是否为动态块
      (progn
        (vlax-for Param (vla-get-Parameters obj)               ;; 遍历动态块的所有参数
          (if (and (vlax-property-available-p Param 'Type)     ;; 检查参数是否有类型属性
                   (= (vla-get-Type Param) acParameterPoint))  ;; 检查参数类型是否为点
            (vlax-for Action (vla-get-Actions Param)           ;; 遍历参数的所有动作
              (if (and (vlax-property-available-p Action 'Type) ;; 检查动作是否有类型属性
                       (= (vla-get-Type Action) acActionStretch)) ;; 检查动作类型是否为拉伸
                (vlax-for Item (vla-get-Items Action)          ;; 遍历动作的所有项
                  (if (and (vlax-property-available-p Item 'Object) ;; 检查项是否有对象属性
                           (setq oName (vla-get-ObjectName Item))) ;; 获取对象的名称
                    (progn
                      (vla-put-color Item Color)               ;; 设置对象颜色
                      (if (not (= (vla-get-layer Item) "0"))   ;; 如果对象的图层不是 "0"
                        (vla-put-layer Item "0")               ;; 将对象的图层设置为 "0"
                      )
                    )
                  )
                )
              )
            )
          )
        )
      )
    )
    (vla-UpDate obj)                                           ;; 更新对象以反映更改
  )
  ;; 主函数逻辑
  (if (and (setq ss (ssget '((0 . "insert"))))                 ;; 获取用户选择的所有插入对象
           (or $ChBlkColor$ (setq $ChBlkColor$ 7))             ;; 如果没有先前选择的颜色，默认使用颜色 7 (白色)
           (setq $ChBlkColor$ (acad_colordlg $ChBlkColor$)))   ;; 打开颜色选择对话框，让用户选择颜色
    (progn
      (setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))) ;; 获取当前文档中的所有块
      (repeat (setq i (sslength ss))                           ;; 遍历选择集中的所有对象
        (setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i))))) ;; 获取选择集中的每个对象
        (ChBlkColor Blks Obj $ChBlkColor$)                     ;; 调用 ChBlkColor 处理对象
      )
    )
  )
  (princ)                                                      ;; 结束函数，抑制输出
) 我改了一下，可以归层，但是有一个问题，有些动态块内部图元改颜色和图层改不了？哪位大神帮忙修改一下。

mercio

bai2000 发表于 2023-11-24 09:35
只能改单个块的颜色，同名块的颜色没同时更新，希望能改进

Re刷新一下，就更新了，这个确实挺好用，跟那个好帮手里的一样功能

kozmosovia

zyxi19 发表于 2024-9-27 22:37
大佬，有改单个块，其余同名块不变色的吗

那得把块做成动态块，否则块不可以各种颜色。要么就是用布局控制显示颜色方式实现。

yaojing38

谢谢，，非常好用

TanK_ZZH

谢谢，确实很好用

hjyocean

不得不说，真的非常好用

bai2000

只能改单个块的颜色，同名块的颜色没同时更新，希望能改进

ZYX2129

谢谢楼主分享

jkop

可以批量选择，可同时修改嵌套块，很好用。

tensir

感谢作者的分享！

zyxi19

要是能改单个块的颜色就好了