更改块内标注没有反应
本帖最后由 zdqwy19 于 2015-11-9 20:07 编辑使用下面这段代码更改块标注文字颜色没有反应(defun c:test ( / a)
(setq a (car (entsel)))
(setqdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq a (vlax-ename->vla-object a))
(setq a (vla-get-name a))
(vlax-for x
(vla-item (vla-get-Blocks (vla-get-activedocument (vlax-get-acad-object))) a)
(if (= (vla-get-objectname x) "AcDbRotatedDimension")
(vla-put-textcolor x acRed);标注文字改为红色
)
)
(vla-regen doc :vlax-true)
)但是如果把代码稍作更改,比如改为直线改为红色,却又运行正常(defun c:test ( / a)
(setq a (car (entsel)))
(setqdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq a (vlax-ename->vla-object a))
(setq a (vla-get-name a))
(vlax-for x
(vla-item (vla-get-Blocks (vla-get-activedocument (vlax-get-acad-object))) a)
(if (= (vla-get-objectname x) "AcDbLine")
(vla-put-color x acRed);直线改为红色
)
)
(vla-regen doc :vlax-true)
)关键是标注已经更改了,块内不刷新,炸开了反而显示了,百思不得其解?
lisp看样子是没有办法了,或者我看到的资料少了 原想写一个块内标注检查的lsp,结果卡在了这里。 给你参考一下别人写的一段代码吧,这是网上找到的,关于改块颜色的一个程序,你自个找找吧。
(defun ChColor (OBJ / oName BlkName)
(setq oName (vla-get-ObjectName OBJ))
(cond
((wcmatch oName "*Dimension,AcDbLeader,AcDbFcf")
(vla-put-DimensionLineColor OBJ $ChColor$)
(if (wcmatch oName "*Dimension")
(progn
(if (vlax-method-applicable-p obj 'ExtensionLineColor) (vla-put-ExtensionLineColor OBJ $ChColor$))
(if (setq
BlkName (assoc 2 (entget (vlax-vla-object->ename OBJ)))
)
(vlax-for OBJ (vla-item Blks (cdr BlkName))
(vla-put-color OBJ $ChColor$)
)
)
)
)
(if (wcmatch oName "*Dimension,AcDbFcf")
(vla-put-TextColor OBJ $ChColor$)
)
)
((= oName "AcDbBlockReference")
(setq BlkName (vla-get-name OBJ))
(if (not (member BlkName BNLst))
(progn
(setq BNLst (cons BlkName BNLst))
(vlax-for X (vla-item Blks BlkName)
(ChColor X)
)
)
)
(if (= (vla-get-HasAttributes OBJ) :vlax-true)
(foreachX (vlax-invoke OBJ 'getattributes)
(vla-put-color X $ChColor$)
)
)
)
)
(vla-put-color obj $ChColor$)
)
页:
[1]