更改块内标注没有反应

zdqwy19 · 发表于 2015-11-9 16:06:31

本帖最后由 zdqwy19 于 2015-11-9 20:07 编辑

使用下面这段代码更改块标注文字颜色没有反应

(defun c:test ( / a)
(setq a (car (entsel)))
(setq doc (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)))
(setq doc (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)
)

关键是标注已经更改了，块内不刷新，炸开了反而显示了，百思不得其解？

zdqwy19 · 发表于 2015-11-12 22:20:49

lisp看样子是没有办法了，或者我看到的资料少了

zdqwy19 · 发表于 2015-11-21 11:47:44

原想写一个块内标注检查的lsp，结果卡在了这里。

waterchen · 发表于 2015-11-21 15:35:07

给你参考一下别人写的一段代码吧，这是网上找到的，关于改块颜色的一个程序，你自个找找吧。

(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)
(foreach X (vlax-invoke OBJ 'getattributes)
(vla-put-color X $ChColor$)
)
)
)
)
(vla-put-color obj $ChColor$)
)

(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) 
       (foreach  X (vlax-invoke OBJ 'getattributes) 
   (vla-put-color X $ChColor$) 
       ) 
     ) 
    ) 
  ) 
  (vla-put-color obj $ChColor$) 
)

账号		自动登录	找回密码
密码			注册

[已解答] 更改块内标注没有反应

浏览过的版块