大佬，有改单个块，其余同名块不变色的吗
那得把块做成动态块，否则块不可以各种颜色。要么就是用布局控制显示颜色方式实现。 谢谢，，非常好用
有一个问题，动态块内部图元没有改颜色。 (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) ;; 结束函数，抑制输出
) 我改了一下，可以归层，但是有一个问题，有些动态块内部图元改颜色和图层改不了？哪位大神帮忙修改一下。 代码只处理动态块的参数而没有处理块内图元 谢谢分享谢谢分享谢谢分享
页:
1
[2]