Script to copy attribute values

[rudrasree]

I had tried to make a script to copy an attribute value from a block and paste the value in another attribute with a prefix say "x" in the same drawing.

Eg. Block "A" with attribute tag VALUE : ACAD. I want to take ACAD from Block A and paste it in Block B as XACAD. which is in the same drawing .

Can anyone help pls.

[dbroad]

For what ACAD version?  IOW, can you use fields?  If so, you could paste a field code that pointed to the other block's attribute contents.  This could be done programmatically but the field would maintain the relationship.

[mid-awe]

I'm not sure if you really need a script or if a LISP will do. so here is an example:

(DEFUN Get-Put-AttVal (TAG1 TAG2 BLOCK1 BLOCK2 / CNT EG EN ENT1 ENT2 ENTINFO KK KS SS SSET VAL)
  (IF (SETQ sset (SSGET "x" (LIST (CONS 2 BLOCK1) (CONS 410 (GETVAR 'ctab)))))
    (PROGN
      (SETQ cnt	    0
	    ent1    (SSNAME sset cnt)
	    ent2    (ENTNEXT ent1)
	    entinfo (ENTGET ent2)
      )
      (WHILE (AND ent2 (= "ATTRIB" (CDR (ASSOC 0 entinfo))))
	(IF (= TAG1 (CDR (ASSOC 2 entinfo)))
	  (PROGN
	    (SETQ VAL (CDR (ASSOC 1 entinfo)))
	    (SETQ ent2 nil)
	  )
	  (PROGN
	    (SETQ ent2 (ENTNEXT ent2))
	    (SETQ entinfo (ENTGET ent2))
	  )
	)
      )
    )
    (ALERT (STRCAT "ERROR: " BLOCK1 " Not Found!"))
  )
  (IF (EVAL VAL)
    (IF	(SETQ SS (SSGET "X" (LIST (CONS 0 "INSERT") (CONS 2 BLOCK2) (CONS 410 (GETVAR 'ctab)))))
      (PROGN
	(SETQ KK 0
	      KS (SSLENGTH SS)
	)
	(WHILE (< KK KS)
	  (SETQ EG (ENTGET (SSNAME SS KK)))
	  (SETQ EN (ENTGET (ENTNEXT (CDR (ASSOC -1 EG)))))
	  (WHILE (AND EN (/= (CDR (ASSOC 0 EN)) "SEQEND"))
	    (IF	(= (CDR (ASSOC 2 EN)) TAG2)
	      (PROGN
		(SETQ EN (SUBST (CONS 1 VAL) (ASSOC 1 EN) EN))
		(ENTMOD EN)
		(ENTUPD (CDR (ASSOC -1 EG)))
		(SETQ EN nil)
	      )
	      (SETQ EN (ENTGET (ENTNEXT (CDR (ASSOC -1 EN)))))
	    )
	  )
	  (SETQ KK (1+ KK))
	)
      )
      (ALERT (STRCAT "ERROR: " BLOCK2 " Not Found!"))
    )
  )
  (PRINC)
)

 Simply use: (Get-Put-AttVal TAG1NAME TAG2NAME BLOCK1NAME BLOCK2NAME) and it can be added into a script.

I hope this is what you were looking for.

[Lee_Mac]

Here's an old program from my library to copy all attribute values from one block to many - it could quite easily be customised to copy specific attribute values to specific tags by adding some appropriate conditional statements:

;; Match Attribute Values  -  Lee Mac
(defun c:mav ( / idx lst ss1 ss2 val )
    (if
        (and
            (princ "\nSelect source block: ")
            (setq ss1 (ssget "_+.:E:S" '((0 . "INSERT") (66 . 1))))
            (princ "\nSelect blocks to match attributes: ")
            (setq ss2 (ssget "_:L"     '((0 . "INSERT") (66 . 1))))
        )
        (progn
            (foreach att (vlax-invoke (vlax-ename->vla-object (ssname ss1 0)) 'getattributes)
                (setq lst (cons (cons (strcase (vla-get-tagstring att)) (vla-get-textstring att)) lst))
            )
            (repeat (setq idx (sslength ss2))
                (foreach att (vlax-invoke (vlax-ename->vla-object (ssname ss2 (setq idx (1- idx)))) 'getattributes)
                    (if (setq val (cdr (assoc (strcase (vla-get-tagstring att)) lst)))
                        (vla-put-textstring att val)
                    )
                )
            )
        )
    )
    (princ)
)
(vl-load-com) (princ)