(vlax-for blk (vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
(vlax-for dim blk
(and (= (substr (vla-get-name dim) 1 2) "*D")
(= (vla-put-ExtensionLineColor dim 1)
(vla-put-DimensionLineColor dim 2)
)
)
)
) 修改框选中的所有标注（含块内标注）的线的颜色，借荐了另一个老师的部分代码
(defun c:tt()
(vl-load-com)
(setq bnlst nil)
(setq ss(ssget '((0 . "insert,*Dimension"))))
(setq col(acad_colordlg 1))
(setq i 0)
(repeat (sslength ss)
(setq obj(ssname ss i) v_obj(vlax-ename->vla-object obj))
(setq blks(vla-get-blocks(vla-get-activedocument(vlax-get-acad-object))))
(If (= (cdr (assoc 0 (entget obj))) "INSERT")
(chblkcolor blks v_obj col)
(progn
(if (and(/= (vla-get-objectname v_obj) "AcDbDiametricDimension")
(/= (vla-get-objectname v_obj) "AcDbRadialDimension")
)
(vla-put-ExtensionLineColor v_obj col)
)
(vla-put-DimensionLineColor v_obj col)
)
)
(setq i(1+ i))
)
)
(defun ChBlkColor (Blks Obj Color / BlkName oName)
;; 定义一个内部递归函数 ChBlkColor，用于处理块的颜色和图层设置
(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
(if (and(/= oname "AcDbDiametricDimension")
(/= oname "AcDbRadialDimension")
)
(vla-put-ExtensionLineColor X Color) ;; 设置延伸线颜色
)
(if (setq BlkName (assoc 2 (entget (vlax-vla-object->ename X)))) ;; 获取尺寸关联的块名称
(vlax-for X (vla-item Blks (cdr BlkName)) ;; 遍历关联块中的所有对象
(if (wcmatch (vla-get-objectname x) "*Line")
(vla-put-color X Color) ;; 设置对象颜色
)
)
)
)
)
)
((= oName "AcDbBlockReference") ;; 如果对象是块引用
(ChBlkColor Blks X Color) ;; 递归调用 ChBlkColor 处理嵌套块
)
)
)
)
)
;;; (vla-UpDate obj) ;; 更新对象以反映更改
(command "regen")
) 多谢大佬分享
页:
1
[2]