如果我理解正确，试一试：
- (defun c:Contact (/ *error* lst2str SourceTag DestTagLst ent1 eLst1 att1 ent2 eLst2 att2 uFlag)
- (vl-load-com)
- ;; Lee Mac ~ 04.02.10
- (setq SourceTag "RDN" DestTagLst '("RDN1" "RDN2"))
- (setq *doc (cond (*doc) ((vla-get-ActiveDocument
- (vlax-get-acad-object)))))
- (defun *error* (msg)
- (and uFlag (vla-EndUndoMark *doc))
- (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
- (princ (strcat "\n** Error: " msg " **")))
- (princ))
- (defun lst2str (lst sep)
- (if (cdr lst)
- (strcat (car lst) sep (lst2str (cdr lst) sep))
- (car lst)))
- (while
- (progn
- (setq ent1 (nentsel (strcat "\nSelect Block or Attrib to get " SourceTag ": ")))
- (cond ( (eq 'ENAME (type (car ent1)))
- (if (or (and (eq "ATTRIB" (cdr (assoc 0 (setq eLst1 (entget (car ent1))))))
- (eq SourceTag (strcase (cdr (assoc 2 eLst1))))
- (setq att1 (vlax-ename->vla-object (car ent1))))
-
- (and (= 4 (length ent1))
- (eq "INSERT" (cdr (assoc 0 (entget (setq ent1 (car (last ent1)))))))
- (progn
- (while (not (eq "SEQEND" (cdr (assoc 0 (entget (setq ent1 (entnext ent1)))))))
- (if (eq SourceTag (cdr (assoc 2 (entget ent1))))
- (setq att1 (vlax-ename->vla-object ent1))))
-
- att1)))
- (while
- (progn
- (setq ent2 (car (nentsel (strcat "\nSelect Destination Attrib for " SourceTag ": "))))
- (cond ( (eq 'ENAME (type ent2))
- (if (eq "ATTRIB" (cdr (assoc 0 (setq eLst2 (entget ent2)))))
-
- (if (vl-position (cdr (assoc 2 eLst2)) DestTagLst)
- (progn
- (setq uFlag (not (vla-StartUndoMark *doc)))
-
- (vla-put-TextString
- (setq att2 (vlax-ename->vla-object ent2))
- (strcat "%<\\AcObjProp Object(%<\\_ObjId "
- (itoa
- (vla-get-ObjectId att1)) ">%).TextString>%"))
- (vla-update att2)
- (setq uFlag (vla-EndUndoMark *doc)))
- (princ (strcat "\n** ATTRIB Must be Either " (lst2str DestTagLst ",") " **")))
- (princ "\n** Object Must be an ATTRIB **"))))))
-
- (princ (strcat "\n** Object Must be an INSERT or ATTRIB with Tag "" SourceTag "" **")))))))
- (vla-regen *doc acActiveViewport)
- (princ))
-
-
-
-
-
-
| 
置顶卡
