更改块的属性标记
我很想知道是否可以使用lisp（或其他策略）更改属性标记名。我有很多不同的块，它们都有两个属性。
属性1的标记为“X”，值为“100”
属性2的标记为“Y”，值为“200”
可以更改图形中的所有块，使属性1标记从“X”重命名为“A”，属性2标记从“Y”重命名为“B”。
如果可能的话，我希望保留和保持与各个属性相关联的值不变，并且只更改标记。因此，基本上，一旦脚本完成，我仍然有两个属性的块，一个具有标记“A”和值“100”，另一个具有标记“B”和值“200”的属性。
澄清；我对替换属性值不感兴趣，而是更改属性标记名。
希望有人能理解，甚至可以实现。
你先在这里搜索论坛了吗？块有很多事情要做，我相信像李·Mac这样的人有一个例程，在一个lisp程序中对块做所有事情。属性标签颜色层等 块和更改属性值上存在堆，但使用自动过程跨图形中的多个块更改属性标记名称的情况并不多见。
我试过李的密码，在这里http://www.cadtutor.net/forum/showthread.php?46101-更改属性块中的标记名称&高亮显示=更改+属性+标记
即
(defun c:attupd (/ ss sel doc lst tag)
(vl-load-com)
(if (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
(progn
(vlax-for Obj (setq sel (vla-get-ActiveSelectionSet
(setq doc (vla-get-ActiveDocument
(vlax-get-acad-object)))))
(vlax-for Sub (vla-item
(vla-get-Blocks doc)
(vla-get-Name Obj))
(if (eq "AcDbAttributeDefinition"
(vla-get-ObjectName Sub))
(setq lst
(cons
(cons
(vla-get-TagString Sub)
(vl-list->string
(subst 95 32
(vl-string->list
(vla-get-PromptString Sub))))) lst))))
(foreach att (vlax-invoke Obj 'GetAttributes)
(if (setq tag (assoc (vla-get-TagString att) lst))
(vla-put-TagString att (cdr tag))))
(setq lst nil))
(vla-delete sel))
(princ "\n** No Attributed Blocks Found **"))
(princ))
不幸的是，我无法让它工作。不确定在我的情况下，我需要修改什么才能在工作中发挥作用。
干杯 我5分钟前读到属性标签是不可更改的，不会爆炸。
然后我发现了一个lisp，它完全否定了这个说法，我很高兴我找到了它。
如果要更改属性块的标记名，请使用以下命令，创建新旧标记名列表。
(defun c:attr_rename_list (/ x_en enn edd ss slen ix atnam
namelist hit blk_ent
matchname newed x)
; Process all block instances on active drawing. Check each
; attribute for match on first element in list below. On any
; match, rename the attribute to the new name given in the
; second element.
; *********** ATTRIBUTE OLD versus NEW names list ******************
(setq namelist (list
; list old name and new name. Old name can contain wild cards.
(list "OLD_TAG_NAME#1" "NEW_TAG_NAME#1"); list old name and new name.
(list "OLD_TAG_NAME#2" "NEW_TAG_NAME#2")
(list "OLD_TAG_NAME#3" "NEW_TAG_NAME#3")
(list "OLD_TAG_NAME#4" "NEW_TAG_NAME#4")
(list "OLD_TAG_NAME#5" "NEW_TAG_NAME#5")
) )
; **********************************************************************
; Extract selection set of all block inserts on active drawing
(setq ss (ssget "_X" '((0 . "INSERT"))))
(if (/= ss nil)
(progn
(setq slen (sslength ss))
(setq ix 0)
(while (< ix slen)
(setq blk_ent (ssname ss ix)) ; get next block insert to process
(setq ix (1+ ix)) ; increment for next time
(setq enn (entnext blk_ent))
(setq edd (entget enn))
(while (AND enn (/= (cdr (assoc 0 edd)) "SEQEND")
(/= (cdr (assoc 0 edd)) "INSERT") )
(if (= (cdr (assoc 0 edd)) "ATTRIB")
(progn
(setq atnam (cdr (assoc 2 edd)))
(setq hit nil)
(foreach x namelist
(if (not hit)
(progn ; no match yet, keep processing
(setq matchname (car x))
(if (wcmatch atnam matchname)
(progn ; found exact match or wild-card match
; Change name now. Substitute in new name.
(setq newed (subst (cons 2 (cadr x)) (assoc 2 edd) edd))
(entmod newed) ; update the title block instance
(entupd blk_ent)
(princ "\n")
(princ atnam)
(princ " --> ")
(princ (cadr x))
(setq hit 1) ; flag that found
) ) ) )
)
)
)
; go to next sub ent in block instance and loop back up
(if (setq enn (entnext enn)) (setq edd (entget enn)))
) )
(setq ss nil) ; release the selection set
)
)
(princ) ; prettier
)
我喜欢找到答案。它让我觉得自己充满活力。 我修改了该脚本，以便可以将旧块的标记更改为新标记，并用新块替换该块。同时将新块缩放到正确的大小。并删除任何不再需要的块。
既然我知道这是多么痛苦。。。。。以下是脚本：
（顺便说一句，我清理了一下，希望我没有移除任何本不应该移除的东西）
defun changeblock (/ BLK DOC I TAGLST SS)
(vl-load-com)
(setq blk "OLDNAMEOFBLOCK"
tagLst '(
;"Old Tag" "New Tag"
("OLDTAG" "NEWTAG")
)
i -1
doc (vla-get-activedocument (vlax-get-acad-object))
)
(if (ssget "_X" (list (cons 0 "INSERT")(cons 2 blk)))
(vlax-for bl (setq ss (vla-get-activeselectionset doc))
(foreach att (vlax-invoke bl 'getAttributes)
(If (assoc (vla-get-tagstring att) tagLst)
(vla-put-tagstring att (cadr (assoc (vla-get-tagstring att) tagLst)))
)))
(princ "\nNo part rule Found."))
(princ)
(progn
(if (tblsearch "BLOCK" "OLDNAMEOFBLOCK")
(progn
(command "-rename" "b" "OLDNAMEOFBLOCK" "NEWNAMEOFBLOCK")
(command "_.-insert" "NEWNAMEOFBLOCK=FILENAME" "y" nil);replaced convert template to new template.
(command "_.attsync" "n" "NEWNAMEOFBLOCK")
(scl 0.8 "NEWNAMEOFBLOCK");scales block to new scale
(blknr13 "NEWNAMEOFBLOCK"); this was command to set a block the a layer. (not included can eb removed)
))
)(princ)(princ "succes!")(princ)
)
;; Run program manually with this:
(defun c:Chblock () (changeblock))
;;itemline
;; Scale the old template to new one
(defun scl (xsc blk / ss)
(vl-load-com)
(if (setq SS (ssget "_X" (list '(0 . "INSERT") (cons 2 blk))))
(mapcar
(function
(lambda (Obj)
(vla-ScaleEntity Obj
(vla-get-insertionpoint Obj)xsc)))
(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp
(mapcar 'cadr (ssnamex ss))))))
(princ))
;;;;;delete;;;;;
;;/delete
(defun delblk (blk / ss)
(vl-load-com)
(if (tblsearch "BLOCK" blk)
(progn
(if (setq ss (ssget "x" (list (cons 0 "INSERT") (cons 2 blk))))
(mapcar 'vla-delete
(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
)
(command "erase" ss "")
)
(command ".purge" "b" blk "n")
)
)
) 你好
我试了一下代码，效果很好。然而，我的问题是我有多个同名的标签。同一块中有三个被调用的名称。
我只需要更改其中一个标记的值，并使用一个Lee Macs LISP程序来尝试更改它。但它失败了，因为有多个同名的标签。我试着用这段代码来更改标签名，但它太难了，更改了所有三个，而不仅仅是一个。
有没有办法重新定位我想重命名的标签？也许使用co ORD？或者一次换一个直到没有更多的名字标签？
目标是最终在许多图形上更改这一属性（工程师的名字）。
干杯
wrightjd是什么代码？根据代码，您可以在标记之外添加另一组条件。告诉我，工程师的名字对每一幅画都一样吗？如果没有，请使用可能包含名称的列表作为元素。
(if(and (eq TAG NAME)(memberTEXTSRING'("Name1" "Name2" ...))) (then do this)) 为回复干杯
我使用了hosannabizarre发布的第二个代码（2010年8月9日下午06:20）
只是看了一下块，有3个标签命名相同，但只有一个将有工程师的名字，我需要更改。该名称在所有图形上都相同，并且其更改为的名称在所有图形上都相同。
有没有办法插入IF语句来说明标记名是否为“name”，标记值是否为“Dennis（BSL）”，然后将标记名从“name”更改为“DESIGN ENG”？
对编程来说真的很陌生，只是在代码中迷失了方向，试图进行更改以适应这个问题。
感谢您的帮助。
这是一个奇怪的请求，您是否希望仅当且仅当标记/TEXSTRING满足条件时才更改标记？
假设“BANANA”的块名有一个标记名为“name”的属性，文本标记为“Dennis（BSL）”，将标记更改为DESIGN_ENG。然后还有另一个标记名为“name”的“BANNA”块，文本标记不是“Dennis（BSL）。标记名会改为“name”吗？
我相信你所指的一切都很好，完全是你想要的（除了“Dennis（BSL）”），但你是否意识到，当你插入块“BANANA”时，仍然有标签“NAME”？当其他人处理图形文件并运行attsync时，它将恢复为其原始标记？
这就是你想要的吗？
演示代码
(defun c:RepEng(/Otag Eng NTag BLocks i Attval Found)
(vl-load-com)
(setq Otag"NAME"
Eng "DENNIS (BSL)"
Ntag "DESIGN_ENG")
(if
(setq Blocks (ssget "_X" '((0 . "INSERT")(66 . 1))))
(repeat (setq i (sslength Blocks))
(setq AttVal
(mapcar (function
(lambda (at)
(list (vla-get-tagstring at)
(vla-get-textstring at)
at)
))
(vlax-invoke
(vlax-ename->vla-object
(ssname Blocks (setq i (1- i))))
'Getattributes)
)
)
(if (setq Found
(Car (vl-remove-if-not
'(lambda (x)
(and (eq (car x) Otag)
(eq (strcase
(cadr x))
Eng)))
AttVal)))
(vla-put-tagstring (last Found) Ntag)
)
)
)
(princ)
)
除非带有多个“名称”标签的块和工程师名称始终在同一顺序上。（例如块的第二个标签），然后重新定义块将是更好的选择。
编辑：我刚刚在另一个论坛上看到你的帖子，你在其中添加了这句话
那样的话忘记我刚才说的一切，用这个
(defun c:RepEng(/Otag Eng NTag BLocks i Attval Found)
(vl-load-com)
(setq Otag"NAME"
Eng "DENNIS (BSL)"
NEng "Daniel" )
(if
(setq Blocks (ssget "_X" '((0 . "INSERT")(66 . 1))))
(repeat (setq i (sslength Blocks))
(setq AttVal
(mapcar (function
(lambda (at)
(list (vla-get-tagstring at)
(vla-get-textstring at)
at)
))
(vlax-invoke
(vlax-ename->vla-object
(ssname Blocks (setq i (1- i))))
'Getattributes)
)
)
(if (setq Found
(Car (vl-remove-if-not
'(lambda (x)
(and (eq (car x) Otag)
(eq (strcase
(cadr x))
Eng)))
AttVal)))
(vla-put-textstring (last Found) NEng)
)
)
)
(princ)
)
您好，谢谢您再次回复。
我想我可能把你搞糊涂了。或者我很困惑。
我附上了一张照片，试图帮助你
我只需要把DESIGN ENG下的名字从原来的名字改成另一个人的名字。除了I有重复的标记名外，其他脚本/程序很容易做到这一点。在本例中，有三个标记名为“NAME”。我需要更改标记的名称，以便使用其他程序更改属性的值。
这有帮助吗？
干杯
页:
[1]
2