|
- (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)
- )
复制代码
|
|