Lisp合并和更新
请帮忙！我需要一个lisp例程，它可以执行以下操作。。。
1） 选择一个块。
2） 从块中的两个独立标签获取信息
第一个标记：NODE\u ID
第二个标签：DEVICE-TYPE_ID
3） 然后，我需要将上面的两个标记与中间的破折号（-）组合。例子：
第一个标记：NODE_ID=1256
第二个标签：DEVICE-TYPE_ID=C5B3
最终=1256-C5B3
4） 然后我需要一个“暂停”来选择几个不同的块并更新以下标记。。。
标记：与组合结果一起处于活动状态。。
标签：激活=1256-C5B3
任何帮助都将不胜感激。 试试这个
;; cca.lsp
(defun C:CCA(/ attent atttag attval elist en head pt ss tail)
(setq osm (getvar "osmode"))
(setvar "osmode" 513)
(setq pt (getpoint
"\n *** Specify point on the source block ***"))
(setq ss (ssget pt (list (cons 0 "INSERT") (cons 66 1))))
(sssetfirst nil ss)
(if ss
(progn
(setq en (ssname ss 0))
(setq elist (entget en))
(while (= (cdr
(assoc 0
(setq elist (entget (entnext
(setq attent (cdr (assoc -1 elist))))))))
"ATTRIB")
(setq atttag (cdr (assoc 2 elist)))
(setq attval (cdr (assoc 1 elist)))
(cond ((eq "NODE_ID" atttag)
(setq head (cdr (assoc 1 elist))))
((eq "DEVICE-TYPE_ID" atttag)
(setq tail (cdr (assoc 1 elist))))
(T nil)
)
(ssdel en ss)
)
)
(princ "\n 0 blocks selected")
)
(sssetfirst nil nil)
(setq ss nil)
(prompt
"\n *** Select all target blocks you need to update ***")
(setq ss (ssget (list (cons 0 "INSERT") (cons 66 1))))
(sssetfirst nil ss)
(if (and head tail ss)
(progn
(while
(setq en (ssname ss 0))
(setq elist (entget en))
(while (= (cdr
(assoc 0
(setq elist (entget (entnext
(setq attent (cdr (assoc -1 elist))))))))
"ATTRIB")
(setq atttag (cdr (assoc 2 elist)))
(if (eq "ACTIVE" atttag)
(progn
(entmod (subst (cons 1 (strcat head "-" tail))
(assoc 1 elist)
elist))
(entupd en)
)
)
(ssdel en ss)
)
)
(sssetfirst nil nil)
)
(princ "\n 0 blocks selected")
)
(setvar "osmode" osm)
(princ)
)
(princ " *** Start command wit CCA ***")
(princ)
~'J'~ Fixo，
谢谢你的快速回复。我试了一下常规动作，上半场不错，但下半场不行。
我选择源块，然后选择需要更新的块，然后发生以下情况。。。。
第一个标记：NODE_ID（这会更新目标块/标记：Active[包括短划线]）。
第二个源块标记：DEVICE-TYPE_ID（目标块/标记中缺少：Active[包括短划线]）。
例子：
源块：第一个标记：NODE\u ID=1256
第二个标签：DEVICE-TYPE_ID=C5B3
==============================
更新后。。。
目标块：标记：ACTIVE=“1256-
目标块末端缺少“C5B3”。 试试这个：
(defun c:tagupd (/ bEnt aEnt aEntLst aNode aType nAtt ss entLst dAtt dAttLst)
(vl-load-com)
(if (and (setq bEnt (car (entsel "\nSelect Block to Retrieve Tag Values >")))
(= "INSERT" (cdr (assoc 0 (entget bEnt))))
(= 1 (cdr (assoc 66 (entget bEnt)))))
(progn
(setq aEnt (entnext bEnt))
(while (not (eq "SEQEND" (cdr (assoc 0 (setq aEntLst (entget aEnt))))))
(cond ((= "NODE_ID" (cdr (assoc 2 aEntLst)))
(setq aNode (cdr (assoc 1 aEntLst))))
((= "DEVICE-TYPE_ID" (cdr (assoc 2 aEntLst)))
(setq aType (cdr (assoc 1 aEntLst)))))
(setq aEnt (entnext aEnt)))
(setq nAtt (strcat aNode (chr 45) aType))
(if (setq ss (ssget (list (cons 0 "INSERT") (cons 66 1)
(if (getvar "CTAB") (cons 410 (getvar "CTAB")) (cons 67 (- 1 (getvar "TILEMODE")))))))
(progn
(setq entLst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(foreach ent entLst
(setq dAtt (entnext ent))
(while (not (eq "SEQEND" (cdr (assoc 0 (setq dAttLst (entget dAtt))))))
(if (= "ACTIVE" (cdr (assoc 2 dAttLst)))
(setq dAttLst (subst (cons 1 nAtt) (assoc 1 dAttLst) dAttLst))
(entmod dAttLst))
(setq dAtt (entnext dAtt)))))
(princ "\n<!> No Destination Blocks Selected <!>")))
(princ "\n<!> No Attributed Block Selected <!>"))
(command "_regenall")
(princ))
对不起，遗漏了一件事：
(defun c:tagupd (/ bEnt aEnt aEntLst aNode aType nAtt ss entLst dAtt dAttLst)
(vl-load-com)
(if (and (setq bEnt (car (entsel "\nSelect Block to Retrieve Tag Values >")))
(= "INSERT" (cdr (assoc 0 (entget bEnt))))
(= 1 (cdr (assoc 66 (entget bEnt)))))
(progn
(setq aEnt (entnext bEnt))
(while (not (eq "SEQEND" (cdr (assoc 0 (setq aEntLst (entget aEnt))))))
(cond ((= "NODE_ID" (cdr (assoc 2 aEntLst)))
(setq aNode (cdr (assoc 1 aEntLst))))
((= "DEVICE-TYPE_ID" (cdr (assoc 2 aEntLst)))
(setq aType (cdr (assoc 1 aEntLst)))))
(setq aEnt (entnext aEnt)))
(setq nAtt (strcat aNode (chr 45) aType))
(if (setq ss (ssget (list (cons 0 "INSERT") (cons 66 1)
(if (getvar "CTAB") (cons 410 (getvar "CTAB")) (cons 67 (- 1 (getvar "TILEMODE")))))))
(progn
(setq entLst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(foreach ent entLst
(setq dAtt (entnext ent))
(while (not (eq "SEQEND" (cdr (assoc 0 (setq dAttLst (entget dAtt))))))
(if (= "ACTIVE" (cdr (assoc 2 dAttLst)))
(progn
(setq dAttLst (subst (cons 1 nAtt) (assoc 1 dAttLst) dAttLst))
(entmod dAttLst)))
(setq dAtt (entnext dAtt)))))
(princ "\n<!> No Destination Blocks Selected <!>")))
(princ "\n<!> No Attributed Block Selected <!>"))
(command "_regenall")
(princ))
李，
工作完美！
非常感谢你。你帮我省了很多时间，我一个人想办法解决这个问题。
没问题，cabltv，-你的LISP请求看起来都很简单，但都是很好的实践 我有一个类似的需要，上述职位。我需要将属性字符串的平衡转移到另一个块。我已附加了一个AutoCAD文件，其中包含要传输到零件标记块的信息表。
ATT-传输。图纸 不是很确定你想要什么，但你可以用多个块做任何事情，这只是识别它们的一个例子，在你的情况下，你是说一个带有标签MM01的块要更新，但存在55次？
作为参考，我们有一个pit计划更新程序，它可以从各地获取信息，但无论单个计划在图形中的什么位置都会更新，这只是块名和标记的情况。
进一步研究自动更新属性。 比加尔，我附上了一个新的CAD文件与我需要的方向。谢谢
物料清单。图纸
页:
[1]