LISP 通过块自定义属性名称更改属性的问题

hljt512

比如有很多块，有的块有个自定义属性,名称是no,有的块没有此属性，现在就是想点击块时，查找是否有此属性，有此属性就将此属性值设计为1，如果没有此属性就添加此属性no，再将此属性设置成1，这样的好实现吗，有没有大神能实现这个功能 ？？？


该贴已经同步到 hljt512的微博

danxingpen

(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)
)

hljt512

danxingpen 发表于 2015-5-29 10:57
(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，能不能麻烦大哥帮我修改修改，达到以上目的，再次感谢大哥

danxingpen

(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)
)
;第二个问题应该是因为属性的大小写的问题,已处理
;第三个问题是我的错误,已改正
;第四个...我用的是隐藏属性,你可以自己看着调整吧

hljt512

danxingpen 发表于 2015-5-30 15:27
(defun c:tt( /  tag value ent entg obj name MustAddAtt attrs attr attrs )
  (setq tag "no")
  (set ...

太感谢了，，我先试着改一下，看能不能完全合我的要求，再把最终源码发上来

hljt512

danxingpen 发表于 2015-5-30 15:27
(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
试着改了很久，还是改不对，，麻烦帮忙改一下，谢谢了

danxingpen

(setq ent(ssname ss (setq n(1- n)) ))

hljt512

danxingpen 发表于 2015-6-1 13:14
(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>

不知道是哪里有错，谢谢大神帮忙

danxingpen

hljt512 发表于 2015-6-1 15:28
(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;下面进行属性的增加-----------------------
          (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)
)