转发 改块的颜色

zyxi19

大佬，有改单个块，其余同名块不变色的吗

儒门小客

非常好用  非常好用

kozmosovia

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

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

阿猪蛋

谢谢，，非常好用

lxl304712346

有一个问题，动态块内部图元没有改颜色。

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)                                                      ;; 结束函数，抑制输出
) 我改了一下，可以归层，但是有一个问题，有些动态块内部图元改颜色和图层改不了？哪位大神帮忙修改一下。

kozmosovia

代码只处理动态块的参数而没有处理块内图元

yefei812678

谢谢分享谢谢分享谢谢分享