块改色插件

admin · 发表于 2024-2-28 17:47:07

(defun c:gk (/ 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 $ChBlkColor0$ (setq $ChBlkColor0$ 7))
)
(progn
(setq $ChBlkColor$ (getint (strcat "\n请输入颜色号(1-255)<" (itoa $ChBlkColor0$) ">:")))
(if (null $ChBlkColor$)
(setq $ChBlkColor$ $ChBlkColor0$)
(setq $ChBlkColor0$ $ChBlkColor$)
)
(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)
)

复制代码

		自动登录	找回密码
密码			立即注册