LISP 通过块自定义属性名称更改属性的问题
比如有很多块，有的块有个自定义属性,名称是no,有的块没有此属性，现在就是想点击块时，查找是否有此属性，有此属性就将此属性值设计为1，如果没有此属性就添加此属性no，再将此属性设置成1，这样的好实现吗，有没有大神能实现这个功能 ？？？http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 hljt512的微博 本帖最后由 danxingpen 于 2015-5-29 10:59 编辑
(defun c:tt( /tag value ent entg obj name MustAddAtt attrs attr attrs )
(setq tag "no")
(setq value "1")
(if (and (setq ent(entsel "\n选择块:"))
(setq entg(entget(car ent)))
(= "INSERT" (cdr(assoc 0 entg)))
)
(progn
;首先判断是否属性块-------------------
(setq obj(vlax-ename->vla-object (car ent)))
(setq name(cdr(assoc 2 entg)))
(if (zerop (vlax-get obj 'HasAttributes))
(setq MustAddAtt t);没有属性,直接添加NO属性------
(progn;有属性,继续判断是否存在NO属性-
(setq MustAddAtt t)
(setq attrs(vlax-invoke obj 'getattributes))
(foreach attr attrs
(if (= tag (vlax-get attr 'tagstring))
(setq MustAddAtt nil)
)
)
)
)
;上面判断是否需要增加属性-------------------------
(if MustAddAtt
(progn;下面进行属性的增加-----------------------
(setq blkdef (vla-item(vla-get-blocks(vla-get-activedocument (vlax-get-acad-object))) name))
(vla-addattribute blkdef 1 acAttributeModeInvisible ""
(vlax-3d-point (list 0 0 0))
tag
"1"
)
(command "_.attsync" "n" name)
)
)
;下面进行属性修改--------------------------------
(foreach attr attrs
(if (= tag (vlax-get attr 'tagstring))
(vlax-put attr value)
)
)
)
)
(princ)
)
danxingpen 发表于 2015-5-29 10:57 http://bbs.mjtd.com/static/image/common/back.gif
(defun c:tt( /tag value ent entg obj name MustAddAtt attrs attr attrs )
(setq tag "no")
(set ...
感谢大哥的热心回复，在我将您的程序测试后发现，由于我之前表达不清楚，导致程序有几个问题：
1、这个程序一次只能选择一个块，而有多个块时就要输入多次命令，由于块太多，所以就要输入太多次，而我是想输入一次命令后选择一次块，执行完程序，再提示选择块，一直循环下去，之到我取消执行程序。
2、如果是我手工从块编辑器中新增了“no”这个属性的话，在输入此命令后，还是会建立一个相同名称的属性，也就是说会有两个“no”属性，一个是手工建立的，一个是程序建立的；
3、如果输入命令之后，再次点击已通过程序建立“no”属性的块，会提示“错误：参数太少”。
4、程序建立的属性只能通过点击块来查看自定义属性，能不能建立后直接显示在块上面，这样我才知道哪些是有此属性的，哪些是没有的。
我才开始学习LISP，能不能麻烦大哥帮我修改修改，达到以上目的，再次感谢大哥 (defun c:tt( /tag value ent entg obj name MustAddAtt attrs attr attrs )
(setq tag "no")
(setq value "1")
;;;(if (and (setq ent(entsel "\n选择块:"))
;;; (setq entg(entget(car ent)))
;;; (= "INSERT" (cdr(assoc 0 entg)))
;;; )
(prompt "选择对象:")
(while (setq ss(ssget (list (cons 0 "INSERT"))))
(progn
(repeat (setq n(sslength ss))
(setq ent(ssname (setq n(1- n)) ss))
(setq entg(entget(car ent)))
(setq obj(vlax-ename->vla-object ent))
;首先判断是否属性块-------------------
(setq name(cdr(assoc 2 entg)))
(if (zerop (vlax-get obj 'HasAttributes))
(setq MustAddAtt t);没有属性,直接添加NO属性------
(progn;有属性,继续判断是否存在NO属性-
(setq MustAddAtt t)
(setq attrs(vlax-invoke obj 'getattributes))
(foreach attr attrs
(if (= (strcase tag) (strcase(vlax-get attr 'tagstring)));都转化为大写,避免大小写的问题---
(setq MustAddAtt nil)
)
)
)
)
;上面判断是否需要增加属性-------------------------
(if MustAddAtt
(progn;下面进行属性的增加-----------------------
(setq blkdef (vla-item(vla-get-blocks(vla-get-activedocument (vlax-get-acad-object))) name))
(vla-addattribute blkdef 250 acAttributeModeInvisible ""
(vlax-3d-point (list 0 0 0))
tag
"1"
)
(command "_.attsync" "n" name)
)
)
;下面进行属性修改--------------------------------
(foreach attr attrs
(if (= tag (vlax-get attr 'tagstring))
(vlax-put attr 'textstring value)
)
)
)
)
)
(princ)
)
;第二个问题应该是因为属性的大小写的问题,已处理
;第三个问题是我的错误,已改正
;第四个...我用的是隐藏属性,你可以自己看着调整吧 danxingpen 发表于 2015-5-30 15:27 static/image/common/back.gif
(defun c:tt( /tag value ent entg obj name MustAddAtt attrs attr attrs )
(setq tag "no")
(set ...
太感谢了，，我先试着改一下，看能不能完全合我的要求，再把最终源码发上来 danxingpen 发表于 2015-5-30 15:27 static/image/common/back.gif
(defun c:tt( /tag value ent entg obj name MustAddAtt attrs attr attrs )
(setq tag "no")
(set ...
(setq ent(ssname (setq n(1- n)) ss))
运行到这句时提示：错误: 参数类型错误: lselsetp
试着改了很久，还是改不对，，麻烦帮忙改一下，谢谢了 (setq ent(ssname ss (setq n(1- n)) )) danxingpen 发表于 2015-6-1 13:14 http://bbs.mjtd.com/static/image/common/back.gif
(setq ent(ssname ss (setq n(1- n)) ))
(setq ent(ssname ss (setq n(1- n)) ))
(setq entg (entget ent))
(setq obj(vlax-ename->vla-object (car ent)))
运行到以上最后一句时提示：错误: 参数类型错误: consp <图元名: 7ed04458>
如果改成(setq obj(vlax-ename->vla-object ent))
则会提示：错误: 函数错误: <图元名: 7effa328>
不知道是哪里有错，谢谢大神帮忙 hljt512 发表于 2015-6-1 15:28 static/image/common/back.gif
(setq ent(ssname ss (setq n(1- n)) ))
(setq entg (entget ent))
(setq obj(vlax-ename->vla-objec ...
(defun c:tt( /tag value ent entg obj name MustAddAtt attrs attr attrs )
(setq tag "no")
(setq value "1")
;;;(if (and (setq ent(entsel "\n选择块:"))
;;; (setq entg(entget(car ent)))
;;; (= "INSERT" (cdr(assoc 0 entg)))
;;; )
(prompt "选择对象:")
(while (setq ss(ssget (list (cons 0 "INSERT"))))
(progn
(repeat (setq n(sslength ss))
(setq ent(ssname ss (setq n(1- n)) ))
(setq entg(entget ent))
(setq obj(vlax-ename->vla-object ent))
;首先判断是否属性块-------------------
(setq name(cdr(assoc 2 entg)))
(if (zerop (vlax-get obj 'HasAttributes))
(setq MustAddAtt t);没有属性,直接添加NO属性------
(progn;有属性,继续判断是否存在NO属性-
(setq MustAddAtt t)
(setq attrs(vlax-invoke obj 'getattributes))
(foreach attr attrs
(if (= (strcase tag) (strcase(vlax-get attr 'tagstring)));都转化为大写,避免大小写的问题---
(setq MustAddAtt nil)
)
)
)
)
;上面判断是否需要增加属性-------------------------
(if MustAddAtt
(progn;下面进行属性的增加-----------------------
(setqblkdef (vla-item(vla-get-blocks(vla-get-activedocument (vlax-get-acad-object))) name))
(vla-addattribute blkdef 250 acAttributeModeInvisible ""
(vlax-3d-point (list 0 0 0))
tag
"1"
)
(command "_.attsync" "n" name)
)
)
;下面进行属性修改--------------------------------
(foreach attr attrs
(if (= tag (vlax-get attr 'tagstring))
(vlax-put attr 'textstring value)
)
)
)
)
)
(princ)
)
页:
[1]