选取INSERT，遍历图块定义修改内部圆颜色为红色VLISP代码

Lisphk · 发表于 2016-9-22 14:55:21

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;;选取INSERT，遍历图块定义修改内部圆颜色为红色
(defun c:tt (/ acdoc acblk acsel name done)
(setq acdoc (vla-get-activedocument (vlax-get-acad-object))
acblk (vla-get-blocks acdoc)
)
(if (ssget '((0 . "INSERT")))
(progn
(vlax-for block (setq acsel (vla-get-activeselectionset acdoc))
(if (not (member (setq name (vlax-get-property
block
(if
(vlax-property-available-p
block
'effectivename
)
'effectivename
'name
)
)
)
done
)
)
(progn
(vlax-for obj (vla-item acblk name)
(if (eq "AcDbCircle"
(vla-get-objectname obj)
)
(vla-put-color obj acred)
)
)
(setq done (cons name done))
)
)
)
(vla-delete acsel)
(vla-regen acdoc acallviewports)
)
)
(princ)
)

;;选取INSERT，遍历图块定义修改内部圆颜色为红色 
(defun c:tt (/ acdoc acblk acsel name done) 
  (setq        acdoc (vla-get-activedocument (vlax-get-acad-object)) 
        acblk (vla-get-blocks acdoc) 
  ) 
  (if (ssget '((0 . "INSERT"))) 
    (progn 
      (vlax-for        block (setq acsel (vla-get-activeselectionset acdoc)) 
        (if (not (member (setq name (vlax-get-property 
                                      block 
                                      (if 
                                        (vlax-property-available-p 
                                          block 
                                          'effectivename 
                                        ) 
                                         'effectivename 
                                         'name 
                                      ) 
                                    ) 
                         ) 
                         done 
                 ) 
            ) 
          (progn 
            (vlax-for obj (vla-item acblk name) 
              (if (eq "AcDbCircle" 
                      (vla-get-objectname obj) 
                  ) 
                (vla-put-color obj acred) 
              ) 
            ) 
            (setq done (cons name done)) 
          ) 
        ) 
      ) 
      (vla-delete acsel) 
      (vla-regen acdoc acallviewports) 
    ) 
  ) 
  (princ) 
)

[it618postdisplay>0]

(vl-load-com)(princ)

[/it618postdisplay]

ymcui2005 · 发表于 2016-9-22 16:35:32

学习一下谢谢

yoyoho · 发表于 2016-9-22 16:47:18

感谢分享学习!!!!

HLCAD · 发表于 2016-9-23 07:58:33

感谢楼主分享源码！！！

cable2004 · 发表于 2016-9-23 08:08:18

学习一下谢谢

whdong76 · 发表于 2016-9-23 08:55:46

学习下.....

爱莫能助 · 发表于 2016-11-9 18:36:17

正在找这个。，学习下

爱莫能助 · 发表于 2016-11-9 19:01:55

大神，如果块中有块，要怎么做呢

marting · 发表于 2016-11-9 19:13:51

爱莫能助发表于 2016-11-9 19:01

遍历块单独做个函数，参数是块名

如果遍历过程中，有遇到块（嵌套），递归调用本函数。

(defun _tt (blk)
(vlax-for .....
   (cond
      ( (if (图块1)
      (_tt 图块1)
      )
      ((....)
      )
   )
)

newer · 发表于 2016-11-9 19:33:59

爱莫能助发表于 2016-11-9 19:01

多利用论坛搜索，用遍历嵌套块做关键字搜索

http://bbs.xdcad.net/thread-338708-1-1.html

爱莫能助 · 发表于 2016-11-10 08:05:59

marting 发表于 2016-11-9 19:13

明白了，谢谢啊

爱莫能助 · 发表于 2016-11-10 08:08:48

newer 发表于 2016-11-9 19:33

谢谢版主，下次多利用下搜索

dnbcgrass · 发表于 2016-11-10 09:32:24

回复学习学习

sh_h · 发表于 2017-6-22 16:31:47

好帖！！！

ming1789 · 发表于 2017-6-23 19:18:04

感謝你的分享

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

[每日一码] 选取INSERT，遍历图块定义修改内部圆颜色为红色VLISP代码

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。