AUTOLISP按TAG1 Va查找块
所以我在这里尝试使用Lee Mac的LISP函数：http://www.cadtutor.net/forum/showthread.php?84816-通过命令行查找并选择具有某些属性的块
我需要做的是：
我有一个街区
-块名称=“VIFCD_001”
-属性=“TAG1”值=“-M161”
**属性TAG1的值总是唯一的，但是可能有多个VIFCD_001块，每个块具有不同的TAG1值**
我需要一个LISP例程来查找TAG1=所在的块，然后将该特定块的属性“DESC”更改为
Lee的LISP函数能够按标记名选择块，这很好，但我似乎不知道如何告诉它然后在该块中查找DESC属性并更改值。
（定义c:setAttrVals（标记名descName）
.....
.....
....
（普林斯）
)
有人能帮忙吗？ 您可以从拾取块开始，以更通用的方法获得其名称，然后选择具有该名称的所有块，然后检查所有这些块的属性标记名=TAG1，然后查看值并更改它。对于所有样式的方法，我最近使用了属性位置而不是所需的标记名，这适用于任何块名。
试试这个
(defun c:test ( / oldtag1 obj bname newstr)
(setq oldtag1 "TAG1") ; attribute tag name
(setq obj (vlax-ename->vla-object (car (entsel "\nPick object"))))
(setq bname (vla-get-name obj)) ; block name need a check for picked a block
(setq ss (ssget "x"(list (cons 0"INSERT") (cons 2 bname))))
(princ "\n")
(setq newstr (getstring "Please enter new value"))
(setq x (sslength ss))
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS (setq x (- x 1)) )) 'getattributes)
(if (= oldtag1 (strcase (vla-get-tagstring att)))
(vla-put-textstring att newstr)
) ; end if
) ; foreach
)
考虑以下代码：
(defun c:doit ( / bln des ent enx flg fnd idx new sel tag )
(setq
bln "VIFCD_001"
tag "DESC"
)
(if (setq sel (ssget "_X" (list '(0 . "INSERT") '(66 . 1) (cons 2 bln))))
(progn
(setq fnd (strcase (getstring t "\nSpecify attribute value to find: "))
new (cons1 (getstring t (strcat "\nSpecify new value for \"" tag "\" attribute: ")))
)
(repeat (setq idx (sslength sel))
(setq ent (entnext (ssname sel (setq idx (1- idx))))
enx (entget ent)
des nil
flg nil
)
(while (= "ATTRIB" (cdr (assoc 0 enx)))
(cond
( (= tag (strcase (cdr (assoc 2 enx))))
(setq des enx)
)
( (or flg (setq flg (wcmatch (strcase (cdr (assoc 1 enx))) fnd))))
)
(setq ent (entnext ent)
enx (entgetent)
)
)
(if (and des flg)
(if (entmod (subst new (assoc 1 des) des))
(entupd (cdr (assoc -1 des)))
)
)
)
)
(princ (strcat "\nNo blocks called \"" bln "\" found in the active drawing."))
)
(princ)
) Lee，当使用（while）循环在属性库中迭代时，为什么不使用“flg”变量来复制（vl some）：
(while (and (= "ATTRIB" (cdr (assoc 0 enx))) (not flg) )
...
); while
如果在遇到“tag”属性之前验证了wcmatch表达式，该怎么办？
啊，我现在明白了，没有仔细阅读任务是什么=误解了编码。
FWIW，这里是另一种方法（从您那里复制了用户提示）：
(defun C:test ( / bnm tag n SS fnd new i o L )
(setq
bnm "VIFCD_001"
tag "DESC"
)
(and
(setq n (_AttdefPosition bnm tag))
(setq SS (ssget "_X" (list '(0 . "INSERT") '(66 . 1) (cons 2 (strcat "`**," bnm)))))
(setq fnd (strcase (getstring t "\nSpecify attribute value to find: ")))
(setq new (getstring t (strcat "\nSpecify new value for \"" tag "\" attribute: ")))
(repeat (setq i (sslength SS))
(and
(eq bnm (vla-get-EffectiveName (setq o (vlax-ename->vla-object (ssname SS (setq i (1- i)))))))
(setq L (vlax-invoke o 'GetAttributes))
(vl-some (function (lambda (x) (wcmatch (strcase (vla-get-TextString x)) fnd))) L)
(vla-put-TextString (nth n L) new)
)
)
)
(princ)
); defun C:test
(defun _AttdefPosition ( bnm tgnm / e i enx f )
(and
(setq e (tblobjname "BLOCK" bnm))
(setq e (cdr (assoc -2 (entget e))))
(setq i -1)
(while (and e (not f))
(setq enx (entget e)) (setq e (entnext e))
(and (member '(0 . "ATTDEF") enx) (setq i (1+ i)))
(setq f (member (cons 2 tgnm) enx))
(and (member '(0 . "SEQEND") enx) (setq e nil))
)
)
(if f i)
); defun _AttdefPosition
我看到你在处理属性时试图限制最多一次迭代，很明显你喜欢想出这么聪明的方法。
我建议不要依赖与每个块引用中遇到属性引用的顺序相对应的块定义中遇到属性定义的顺序，因为可以独立于块定义生成属性引用，因此不能保证两者完全一致。使用属性时，使用属性标记来区分属性几乎总是更好的（除非您被迫使用其他标记，例如，如果使用了重复的标记-IMO，AutoCAD应该防止这种情况发生）。
谢谢——不过，在效率和可读性之间保持平衡总是值得的：极其高效的代码可能会变得难以置信地不可读，因此在一般应用程序中很难维护。 FWIW，如果你想使用vl-some来限制迭代，这里有另一种方法：
(defun c:doit ( / bln dsc flg fnd idx new sel tag )
(setq
bln "VIFCD_001"
tag "DESC"
)
(if (setq sel (ssget "_X" (list '(0 . "INSERT") '(66 . 1) (cons 2 bln))))
(progn
(setq fnd (strcase (getstring t "\nSpecify attribute value to find: "))
new (getstring t (strcat "\nSpecify new value for \"" tag "\" attribute: "))
)
(repeat (setq idx (sslength sel))
(if (vl-some
'(lambda ( att )
(or flg (setq flg (wcmatch (strcase (vla-get-textstring att)) fnd)))
(or dsc (if (= tag (strcase (vla-get-tagstring att))) (setq dsc att)))
(and flg dsc)
)
(vlax-invoke (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) 'getattributes)
)
(vla-put-textstring dsc new)
)
(setq flg nil dsc nil)
)
)
(princ (strcat "\nNo blocks called \"" bln "\" found in the active drawing."))
)
(princ)
)
(vl-load-com) (princ)
谢谢李-我想听听你对我发布的（实验）代码的看法，因为我没有那么多经验，尽管我通常直接使用标记字符串比较方法处理属性引用。
啊，是的，我已经忘记了——在我迭代所有属性引用之前，直到我学会了如何使用（vl-some）并忘记了重复标记的可能性。
现在我明白了为什么您决定处理每个块的所有属性。
我同意这一点，除非代码被用作子函数，所以你只需要知道它的输入是什么，应该返回什么。
然后可以通过解析输入来避免调试上的麻烦。即。：
(setq elephant (cow->elephant (sheep->cow (dog->sheep (cat->dog (mouse->cat (fly->mouse fly)))))))
我只是把我的机会留给读这篇文章的人（而不是试图辅导你）。
谢谢你把你的建议贴在（vl-some）上——这会让一些试图学习新东西的人感到困惑。
我喜欢你做的lambda部分：
'(lambda ( att )
(or flg (setq flg (wcmatch (strcase (vla-get-textstring att)) fnd)))
(or dsc (if (= tag (strcase (vla-get-tagstring att))) (setq dsc att)))
(and flg dsc)
)
如果不同项目有多个需求，那么限制迭代似乎是非常方便的方法。
页:
[1]