明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 883|回复: 3

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

[复制链接]
发表于 2015-11-9 16:06 | 显示全部楼层 |阅读模式
本帖最后由 zdqwy19 于 2015-11-9 20:07 编辑

       使用下面这段代码更改块标注文字颜色没有反应
  1. (defun c:test ( / a)
  2.   (setq a (car (entsel)))
  3.   (setq  doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  4.   (setq a (vlax-ename->vla-object a))
  5.   (setq a (vla-get-name a))
  6.   (vlax-for x
  7.     (vla-item (vla-get-Blocks (vla-get-activedocument (vlax-get-acad-object))) a)
  8.     (if (= (vla-get-objectname x) "AcDbRotatedDimension")
  9.       (vla-put-textcolor x acRed);标注文字改为红色
  10.     )
  11.   )
  12.   (vla-regen doc :vlax-true)
  13. )
但是如果把代码稍作更改,比如改为直线改为红色,却又运行正常
  1. (defun c:test ( / a)
  2.   (setq a (car (entsel)))
  3.   (setq  doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  4.   (setq a (vlax-ename->vla-object a))
  5.   (setq a (vla-get-name a))
  6.   (vlax-for x
  7.     (vla-item (vla-get-Blocks (vla-get-activedocument (vlax-get-acad-object))) a)
  8.     (if (= (vla-get-objectname x) "AcDbLine")
  9.       (vla-put-color x acRed);直线改为红色
  10.     )
  11.   )
  12.   (vla-regen doc :vlax-true)
  13. )
关键是标注已经更改了,块内不刷新,炸开了反而显示了,百思不得其解?






"觉得好,就打赏"
还没有人打赏,支持一下
 楼主| 发表于 2015-11-12 22:20 | 显示全部楼层
lisp看样子是没有办法了,或者我看到的资料少了
 楼主| 发表于 2015-11-21 11:47 | 显示全部楼层
原想写一个块内标注检查的lsp,结果卡在了这里。
发表于 2015-11-21 15:35 | 显示全部楼层
给你参考一下别人写的一段代码吧,这是网上找到的,关于改块颜色的一个程序,你自个找找吧。
  1. (defun ChColor (OBJ / oName BlkName)
  2.   (setq oName (vla-get-ObjectName OBJ))
  3.   (cond
  4.     ((wcmatch oName "*Dimension,AcDbLeader,AcDbFcf")
  5.      (vla-put-DimensionLineColor OBJ $ChColor$)
  6.      (if (wcmatch oName "*Dimension")
  7.        (progn
  8.    (if (vlax-method-applicable-p obj 'ExtensionLineColor) (vla-put-ExtensionLineColor OBJ $ChColor$))
  9.    (if (setq
  10.          BlkName (assoc 2 (entget (vlax-vla-object->ename OBJ)))
  11.        )
  12.      (vlax-for OBJ (vla-item Blks (cdr BlkName))
  13.        (vla-put-color OBJ $ChColor$)
  14.      )
  15.    )
  16.        )
  17.      )
  18.      (if (wcmatch oName "*Dimension,AcDbFcf")
  19.        (vla-put-TextColor OBJ $ChColor$)
  20.      )
  21.     )
  22.     ((= oName "AcDbBlockReference")
  23.      (setq BlkName (vla-get-name OBJ))
  24.      (if (not (member BlkName BNLst))
  25.        (progn
  26.    (setq BNLst (cons BlkName BNLst))
  27.    (vlax-for X (vla-item Blks BlkName)
  28.      (ChColor X)
  29.    )
  30.        )
  31.      )
  32.      (if (= (vla-get-HasAttributes OBJ) :vlax-true)
  33.        (foreach  X (vlax-invoke OBJ 'getattributes)
  34.    (vla-put-color X $ChColor$)
  35.        )
  36.      )
  37.     )
  38.   )
  39.   (vla-put-color obj $ChColor$)
  40. )
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-30 00:01 , Processed in 0.178496 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表