找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 2768|回复: 5

[分享]:得到块的属性,改块的属性

[复制链接]

已领礼包: 488个

财富等级: 日进斗金

发表于 2003-6-26 21:41:46 | 显示全部楼层 |阅读模式

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

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

×

  1. ;;;;;*********************************得到所有属性 '((tag1 text1)(tag2 text2).......)
  2. (defun get-att (e / a)
  3.   (setq a (vlax-ename->vla-object e))
  4.   (if (and
  5.         (= "AcDbBlockReference" (vla-get-objectname a))
  6.         (= ':vlax-true (vlax-get-property a 'HasAttributes))
  7.       )
  8.     (progn
  9.       (setq a (vla-GetAttributes a)
  10.             a (vlax-safearray->list (vlax-variant-value a))
  11.       )
  12.       (mapcar
  13.         '(lambda (x)
  14.            (list (vlax-get-property x 'TagString)
  15.                  (vlax-get-property x 'TextString)
  16.            )
  17.          )
  18.         a
  19.       )
  20.     )
  21.     nil
  22.   )
  23. )

  24. ;;;;;;;********************************改属性
  25.                                       ;(change-att nil newstr) 改第一个属性
  26.                                       ;(change-att tag newstr) 改那个tag标签属性
  27.                                       ;(change-att (list tag1 tag2..)(list new1 new2...)) 一个个改
  28.                                       
  29. (defun change-att (e tag str / a b)
  30.   (setq a (vlax-ename->vla-object e))
  31.   (if (= ':vlax-true (vlax-get-property a 'HasAttributes))
  32.     (progn
  33.       (setq a (vla-GetAttributes a)
  34.             a (vlax-safearray->list (vlax-variant-value a))
  35.       )
  36.       (cond
  37.         ((and
  38.            (null tag)
  39.            (= 'STR (type str))
  40.          )
  41.           (vlax-put-property (car a) 'TextString str)
  42.         )
  43.         ((and
  44.            (= 'STR (type tag))
  45.            (= 'STR (type str))
  46.          )
  47.           (foreach k a
  48.             (if (= tag (vlax-get-property k 'TagString))
  49.               (vlax-put-property k 'TextString str)
  50.             )
  51.           )
  52.         )
  53.         ((and
  54.            (listp tag)
  55.            (listp str)
  56.          )
  57.           (foreach k a
  58.             (if (member (setq b (vlax-get-property k 'TagString))
  59.                         tag
  60.                 )
  61.               (vlax-put-property k 'TextString (nth (vl-position b tag) str))
  62.             )
  63.           )
  64.         )
  65.       )
  66.       (vla-update (vlax-ename->vla-object e))
  67.     )
  68.   )
  69. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2003-6-27 08:44:34 | 显示全部楼层
斑竹,这个怎么用啊?为什么说参数太少呢?
另外,能不能编一个,先将选中的部分做成块,然后定义几个属性,再然后编辑这些属性,
这个过程一气呵成,那就爽了。做块程序如下:
code: (defun c:test (/ ss)
  (setq ss (ssget))
  (command ".copybase" (getvar "viewctr") ss "")
  (command ".erase" ss "")
  (command ".pasteblock" (getvar "viewctr"))
  (princ)
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 593个

财富等级: 财运亨通

发表于 2003-6-27 18:53:46 | 显示全部楼层
这样改了下

  1. (defun GetAttributes (obj / lst)
  2.   ;(vl-load-com)
  3.   (if (safearray-value
  4.         (setq lst (vlax-variant-value
  5.                     (vla-getattributes obj)
  6.                   )
  7.         )
  8.       )
  9.     (mapcar '(lambda (x)
  10.                (list (vla-get-tagstring x)
  11.                      (vla-get-textstring x)
  12.                      (vlax-vla-object->ename x)
  13.                )
  14.              )
  15.             (vlax-safearray->list lst)
  16.     )
  17.   )
  18. )
  19. ;;;;;
  20. ;;e 块实体  attlst 属性表 ((tag1 txt1) (tag2 txt2) (tag3 (tagn txt3)) ...)
  21. (defun ch-att        (e attlst / obj att txtobj)
  22.   (setq obj (vlax-ename->vla-object e))
  23.   (if (wcmatch (vla-get-objectname obj) "*Blcok*")
  24.     (if        (= ':vlax-true (vlax-get-property obj 'HasAttributes))
  25.       (progn
  26.         (setq att (GetAttributes obj))
  27.         (foreach x attlst
  28.           (setq txtobj (last (assoc (car x) att)))
  29.           (if txtobj
  30.             (cond
  31.               ((= 'LIST (type (cadr x)))
  32.                (vla-put-tagstring
  33.                  (vlax-ename->vla-object txtobj)
  34.                  (caadr x)
  35.                )
  36.                (vla-put-textstring
  37.                  (vlax-ename->vla-object txtobj)
  38.                  (cadadr x)
  39.                )
  40.               )
  41.               (t
  42.                (vla-put-textstring
  43.                  (vlax-ename->vla-object txtobj)
  44.                  (cadr x)
  45.                )
  46.               )
  47.             )
  48.           )
  49.         )
  50.       )
  51.     )
  52.   )
  53. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 488个

财富等级: 日进斗金

 楼主| 发表于 2003-6-27 21:16:32 | 显示全部楼层
你这么写,有违我的初衷:

(get-att (car(entsel))--->不管点到什么,都能安全退出.

(chang-att ..)
为什么要三种可能:1-很多图块只有一个属性,就不要刨根问底tag是什么了.
                                 2-只改里面的一个tag省得忘了list...
                                 3-写程序,肯定是所有的tag的一个表放在手头了,拿过来就用.或者拎几个出来.
                                     当然第三种改成你的也行,和get相配.或者把你的设成第四种情况.(change-att list nil)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1336个

财富等级: 财源广进

发表于 2014-9-17 19:45:03 | 显示全部楼层
非常感谢。今天用到了。谢谢!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2014-9-20 21:45:11 | 显示全部楼层
谢谢了{:soso_e189:}
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-14 21:58 , Processed in 0.183229 second(s), 41 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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