Copy Values From one Attribute Block to Selected Block Using Prompt

[aamos]

I found the lisp routine below and I changed vla-get-tagstring to vla-get-promptstring and I get the error... ActiveX Server returned the error: unknown name: PromptString.

The presence of duplicate attribute tags with the blocks I'm working with requires me to opting to use the attribute prompt to identify the attributes.

Please help me to understand what can be done to copy Copy values from one Attribute block to selected block using prompt.  

(defun c:MAV (/ AT:GetSel atts ss i ass)
;; Match Attribute Values
;; Alan J. Thompson, 2017.01.31

(defun AT:GetSel (meth msg fnc / ent)
;; meth - selection method (entsel, nentsel, nentselp)
;; msg - message to display (nil for default)
;; fnc - optional function to apply to selected object
;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
;; Alan J. Thompson, 05.25.10
(while
(progn (setvar 'ERRNO 0)
(setq ent (meth (cond (msg)
("\nSelect object: ")
)
)
)
(cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
((eq (type (car ent)) 'ENAME)
(if (and fnc (not (fnc ent)))
(princ "\nInvalid object!")
)
)
)
)
)
ent
)

(if (and (AT:GetSel entsel
"\nSelect source attributed block: "
(lambda (x / d)
(if (and (eq (cdr (assoc 0 (setq d (entget (car x))))) "INSERT")
(eq (cdr (assoc 66 d)) 1)
)
(setq atts (mapcar (function (lambda (a) (cons (vla-get-promptstring a) (vla-get-textstring a))))
(vlax-invoke (vlax-ename->vla-object (car x)) 'GetAttributes)
)
)
)
)
)
(progn
(princ "\nSelect destination attributed block(s): ")
(setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
)
)
(repeat (setq i (sslength ss))
(foreach a (vlax-invoke (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'GetAttributes)
(if (setq ass (cdr (assoc (vla-get-promptstring a) atts)))
(vla-put-textstring a ass)
)
)
)
)

(princ)
)
(vl-load-com)
(princ)

[ronjonp]

@aamos 

PromptString is a property of an IAcadAttribute (0 . "ATTDEF") and you're cycling through IAcadAttributeReference (0 . "ATTRIB") which is why you're getting an error.

Post a sample drawing of what you're working with.

[aamos]

There are duplicate tags on an existing block with attributes. The Prompt information on the block is more diverse. Is there a line in the lisp program that can be changed to cycle through IAcadAttribute (0 . "ATTDEF")?

[ronjonp]

Assuming you're matching one titleblock with another that is exactly the same, then all you have to do is fill the attributes in top to bottom. Give this mod a try:

(defun c:mav (/ at:getsel atts ss i ass)
  ;; Match Attribute Values
  ;; Alan J. Thompson, 2017.01.31
  (defun at:getsel (meth msg fnc / ent)
    ;; meth - selection method (entsel, nentsel, nentselp)
    ;; msg - message to display (nil for default)
    ;; fnc - optional function to apply to selected object
    ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
    ;; Alan J. Thompson, 05.25.10
    (while (progn (setvar 'errno 0)
		  (setq	ent (meth (cond	(msg)
					("\nSelect object: ")
				  )
			    )
		  )
		  (cond	((eq (getvar 'errno) 7) (princ "\nMissed, try again."))
			((eq (type (car ent)) 'ename)
			 (if (and fnc (not (fnc ent)))
			   (princ "\nInvalid object!")
			 )
			)
		  )
	   )
    )
    ent
  )
  (if
    (and
      (at:getsel
	entsel
	"\nSelect source attributed block: "
	(lambda	(x / d)
	  (if
	    (and (eq (cdr (assoc 0 (setq d (entget (car x))))) "INSERT") (eq (cdr (assoc 66 d)) 1))
	     (setq atts	(mapcar	'vla-get-textstring
				(vlax-invoke (vlax-ename->vla-object (car x)) 'getattributes)
			)
	     )
	  )
	)
      )
      (progn (princ "\nSelect destination attributed block(s): ")
	     (setq ss (ssget "_:L" (list '(0 . "INSERT") '(66 . 1))))
      )
    )
     (repeat (setq i (sslength ss))
       (foreach	a (vlax-invoke (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'getattributes)
	 (vla-put-textstring a (car atts))
	 (setq atts (cdr atts))
       )
     )
  )
  (princ)
)
(vl-load-com)
(princ)

[paullimapa]

To get the attdef prompt value you'll have to get both the source & destination block's name:

Source block's name:

(setq blknam-source(cdr (assoc 2 d)))

Destination block's name:

(setq blknam-destination (ssname ss (cdr (assoc 2 (entget (setq i (1- i)))))))

Then use this function to get the block definition's entity for both:

(setq en-source (tblobjname "Block" blknam-source)
      en-destination (tblobjname "Block" blknam-destination)
)

The first attribute def would then be the next entity:

(setq sen-source (entnext en-source)
      sen-destination (entnext en-destination)
)

Now you get the entity data of this attribute definition with:

(setq sed-source (entget sen-source)
      sed-destination (entget sen-destination)
)

The associated pairs to focus on are:

1 = default value

2 = tag name

3 = prompt value

So to get the tag vs prompt for each:

(setq tag-source (cdr (assoc 2 sed-source))
      tag-destination (cdr (assoc 2 sed-destination))
      prompt-source (cdr (assoc 3 sed-source))
      prompt-destination (cdr (assoc 3 sed-destination))
)

So you can setup a while loop to loop through using entnext function till you reach end of the attribute definition list which will eq "SEQEND"

; for looping through source attdef
(while sen-source
 (if(/= (cdr(assoc 0 sed-source)) "SEQEND")
    (progn
     (setq sen-source (entnext sen-source)
           sed-source (entget sen-source)
     ) 
    )
    (setq sen-source nil)
 ) ; if
) ; while
; for looping through destination attdef
(while sen-destination
 (if(/= (cdr(assoc 0 sed-destination)) "SEQEND")
    (progn
     (setq sen-destination (entnext sen-destination)
           sed-destination (entget sen-destination)
     ) 
    )
    (setq sen-destination nil)
 ) ; if
) ; while

[aamos]

Yes, it works for the same blocks. The goal is to create a lisp routine that will copy the attribute values from the old block DIEBORD to the new block DIE_TEMPLATE using the prompt information from the old block DIEBORD. Attached is an Excel file with the information of the attribute Prompt and Tag of the old and new block.   The comparison is horizontal on each row between attributes on the file. Data transfer can be done to the new block DIE_TEMPLATE easily since all tags are different.

[ronjonp]

Another hurdle using ASSOC on a list ( as done in the code ) is it's going to grab the first item and change it. Drawn by, rev desc and rev date will be updated with the last value found unless removed from the checked list and it still may not be in the correct order.

[aamos]

Thank you for the reply Paul. I have used the information you sent me on the lisp code below. I changed the information below line 35 only to have prompt-source and tag-destination.

I made a compare-list to associate the prompts on the source block to the tags on the destination block.

How do I use the compare-list to loop through the source block to get value data and then through the destination block to transfer value data?

(defun c:diebordtodietemplate (/)

  (setq compare-list '(("ALLOY AND TEMPER" "MATERIAL") ("APPROVED BY" "APPRD_BY") ("DATE" "DATE")
						  ("DESCRIPTION" "DESCRIPTION") ("DRAWING NUMBER (LOW)" "PART_NO_LOW")
						  ("DRAWING NUMBER (UPPER)" "PART_NO_UP") ("ENG. CHANGE NO. (1st)" "ECO_NO_1")
						  ("ENG. CHANGE NO. (2nd)" "ECO_NO_2") ("ENG. CHANGE NO. (3rd)" "ECO_NO_3")
						  ("FINISH" "FINISH") ("MATES W/ EXTRUSIONS" "MATE_WITH")
						  ("REVISION LEVEL (LOWER)" "REV_LOW") ("REVISION LEVEL (UPPER)" "REV_UP")
						  ("REVISION NUMBER (1st)" "ECO_REV_1") ("REVISION NUMBER (2nd)" "ECO_REV_2")
						  ("REVISION NUMBER (3rd)" "ECO_REV_3") ("SCALE" "SCALE")
						  ("SYSTEM" "SYS") ("Typ. Radius" "TYP_RAD"))) ;search list of DIEBORD Attribute Prompts to DIE_TEMPLATE Attribute Tags
						  
;To get the attdef prompt value you'll have to get both the source & destination block's name:	
	(setq blknam-source(cdr (assoc 2 d))) ;Source block's name
	(setq blknam-destination (ssname ss (cdr (assoc 2 (entget (setq i (1- i))))))) ;Destination block's name
	
;Then use this function to get the block definition's entity for both:	
	(setq en-source (tblobjname "DIEBORD" blknam-source)
      en-destination (tblobjname "DIE_TEMPLATE" blknam-destination)
)

;The first attribute def would then be the next entity
	(setq sen-source (entnext en-source)
      sen-destination (entnext en-destination)
)
;Now you get the entity data of this attribute definition with
	(setq sed-source (entget sen-source)
      sed-destination (entget sen-destination)
)

;The associated pairs to focus on are:
;1 = default value
;2 = tag name
;3 = prompt value
;So to get the tag vs prompt for each:	
	(setq prompt-source (cdr (assoc 3 sed-source))
      tag-destination (cdr (assoc 2 sed-destination))
)

;So you can setup a while loop to loop through using entnext function till you reach end of the attribute definition list which will eq "SEQEND"
; for looping through source attdef
(while sen-source
 (if(/= (cdr(assoc 0 sed-source)) "SEQEND")
    (progn
     (setq sen-source (entnext sen-source)
           sed-source (entget sen-source)
     ) 
    )
    (setq sen-source nil)
 ) ; if
) ; while
; for looping through destination attdef
(while sen-destination
 (if(/= (cdr(assoc 0 sed-destination)) "SEQEND")
    (progn
     (setq sen-destination (entnext sen-destination)
           sed-destination (entget sen-destination)
     ) 
    )
    (setq sen-destination nil)
 ) ; if
) ; while

  (princ)) 

[paullimapa]

Could you share your old & new title blocks with these attributes for me to take a look?

[aamos]

Yes, attached are the old & new title blocks with these attributes. I also included an Excel file for comparison.

[paullimapa · Accepted solution]

Give this modified mav.lsp a try...seems to work when I ran it on your sample dwg.

Since the block attributes for the source and destination needs to be specific so that the attribute tags can be matched and found I went ahead and just defined the source and destination block names at the beginning. If you need to change them these can be easily modified in the code:

(setq blkname-source "DIEBORD" 
      blkname-destination "DIE_TEMPLATE"

So I first did an attsync to make sure the block attribute definition macthes with the inserted block and then I looped through the block definition collecting all the prompts into a list. 

 (command "_.Attsync" "_N" blkname-source) ; make sure source inserted block attributes match with block definition order
 (while en-source ; cycle through block definition to get prompt list order
  (setq ed-source (entget en-source))
  (if (eq "ATTDEF" (cdr (assoc 0 ed-source))) 
   (progn
    (setq prompt (cdr(assoc 3 ed-source)))
     (setq prompt-source (append prompt-source (list prompt)))
   ) ; progn
  )     
  (setq en-source (entnext en-source))
 ) ; while

Since the source inserted block attribute order is the same as the prompt list from the block definition, this is the same order I retrieved the values ignoring the need to look at the tagname  and I used that to find the matching tagname to the destination-list based on your compare-list:

(while sen-source
    (setq sed-source (entget sen-source))
;1 = value
;2 = tag name
;3 = prompt value	
    (cond
     ((eq (cdr (assoc 0 sed-source)) "ATTRIB") ; found attrib
;     (if (and (/= "FILENAME" prompt)(/= "DRAWN BY" prompt)(/= "REV. DESCRIPTION" prompt)(/= "REVISION DATE" prompt)) ; there are more than one 
  	   (if (setq itm (assoc (nth count prompt-source) compare-list)) ; locate item from compare-list
	     ; list of destination tag & source attrib value
        (setq destination-list (append destination-list (list (cons (cadr itm) (cdr (assoc 1 sed-source)))))) 
       ) ; if
;	    )
      (setq count (1+ count) ; move onto next
            sen-source (entnext sen-source)
	    ) 
	   )
	   ((/= (cdr (assoc 0 sed-source)) "SEQEND")
      (setq sen-source nil) ; end while loop
	   )
	   (t 
	    (setq sen-source (entnext sen-source)) ; move onto next
	   )
    ) ; cond
   ) ; while    

Then the last step uses your code to loop through all the destination block attributes matching the tag name to the found value in the destination-list:

(repeat (setq count (sslength entsel-destination))
  (foreach a (vlax-invoke (vlax-ename->vla-object (ssname entsel-destination (setq count (1- count)))) 'getattributes)
    (if (setq found (assoc (vla-get-TagString a) destination-list)) ; look for match in list
	   (vla-put-textstring a (cdr found)) ; replace attrib value
    ) ; if
  ) ; foreach
 ) ; repeat

[aamos]

Paul, It works for the unique prompts, thank you very much. I'm grateful for the knowledge you've shared. 

For the remaining duplicated prompts it is possible to add them based on a specified order from the Enhanced Attribute Editor on the source to the destination tag name. Message 4 from ronjonp lisp code transfers the attributes in top to bottom. On the LISP code below I added compare-list2 to associate the specified order on the source block to the tags on the destination block. 

What will need to be added to the modified mav.lsp file to also search based on the compare-list2 to retrieved the values?

(setq blkname-source "DIEBORD" 
      blkname-destination "DIE_TEMPLATE"
      en-source (tblobjname "BLOCK" blkname-source) 
      compare-list '(("ALLOY AND TEMPER" "MATERIAL") ("APPROVED BY" "APPRD_BY") ("DATE" "DATE")
					 ("DESCRIPTION" "DESCRIPTION") ("DRAWING NUMBER (LOW)" "PART_NO_LOW")
					 ("DRAWING NUMBER (UPPER)" "PART_NO_UP") ("ENG. CHANGE NO. (1st)" "ECO_NO_1")
					 ("ENG. CHANGE NO. (2nd)" "ECO_NO_2") ("ENG. CHANGE NO. (3rd)" "ECO_NO_3")
					 ("FINISH " "FINISH") ("MATES W/ EXTRUSIONS" "MATE_WITH")
					 ("REVISION LEVEL (LOWER)" "REV_LOW") ("REVISION LEVEL (UPPER)" "REV_UP")
					 ("REVISION NUMBER (1st)" "ECO_REV_1") ("REVISION NUMBER (2nd)" "ECO_REV_2")
					 ("REVISION NUMBER (3rd)" "ECO_REV_3") ("SCALE" "SCALE")
					 ("SYSTEM" "SYS") ("Typ. Radius" "TYP_RAD")
					) ; list of source prompt & destination tag
	  compare-list2 '(("12" "DWN_BY") ("18" "ECO_REV_BY_1")
						  ("19" "ECO_REV_DESC_1") ("20" "ECO_REV_DATE_1")
						  ("23" "ECO_REV_BY_2") ("24" "ECO_REV_DESC_2")
						  ("25" "ECO_REV_DATE_2") ("28" "ECO_REV_BY_3")
						  ("29" "ECO_REV_DESC_3") ("30" "ECO_REV_DATE_3")
					) ; list of source order & destination tag
)

Numbers on the left on image below shows source order number for duplicated prompts on source block. Orange line is a path from source to to destination.

[paullimapa · Accepted solution]

Updated mav.lsp but no error checking...again assumes destination block has all the tag names defined in your compare-list2.  

Basically added the following:

((eq (cdr (assoc 0 sed-source)) "ATTRIB") ; found attrib
       (setq complete-list (append complete-list (list (cdr (assoc 1 sed-source))))) ; create complete list of attribute values baesd on current order
  	   (if (setq itm (assoc (nth count prompt-source) compare-list)) ; locate item from compare-list
	     ; list of destination tag & source attrib value
        (setq destination-list (append destination-list (list (cons (cadr itm) (cdr (assoc 1 sed-source)))))) 
       ) ; if
      (setq count (1+ count) ; move onto next
            sen-source (entnext sen-source)
	    ) 
	   )

Defined a complete-list based on attrib order of all the values currently entered in source block regardless if these are found in compare-list

Then as code loops through the selected destination blocks do a second foreach in this case on compare-list2:

(repeat (setq count (sslength entsel-destination))
  (foreach a (vlax-invoke (vlax-ename->vla-object (setq ent (ssname entsel-destination (setq count (1- count))))) 'getattributes)
    (if (setq found (assoc (vla-get-TagString a) destination-list)) ; look for match in list
	   (vla-put-textstring a (cdr found)) ; replace attrib value
    ) ; if
  ) ; foreach
  (foreach itm compare-list2 
   (setq idx (1- (atoi (car itm))) ; get order list index
         tag (cadr itm) ; get tag name
   )
   (setpropertyvalue ent tag (nth idx complete-list)) ; assumes attrib tag name exists in selected destination block
  ) ; foreach
 )

Breaking the above 2nd foreach lines of code down:

Since the first item in each of your compare-list2 items is defined as a string "12" "18" "19" and etc, then just use car function to get this. But to get this position as the index number of complete-list it needs to be converted from a string to an integer using atoi function and subtracted by one 1- because AutoLISP treats the first item in a list not as #1 but #0:

(setq idx (1- (atoi (car itm))) 
      tag (cadr itm) ; get tag name
)

Since the 2nd item in each of your compare-list2 is the attribute tag, then just use cadr function.

Finally use AutoLISP's built-in setpropertyvalue function to place the attribute value from source block found using the index of complete-list and then reference the tag name from your compare-list2 onto the destination block:

(setpropertyvalue ent tag (nth idx complete-list))

Note: I defined ent to reference the destination block back in the first foreach loop:

(setq ent (ssname entsel-destination (setq count (1- count))))

[aamos]

Paul, 

The updated mav file now transfers all the information from the old template to the new.

Thank you for taking the time to share this knowledge with me. I truly appreciate it.

[paullimapa]

Glad to have helped…cheers!!!

[aamos]

Paul,

I removed the command _.Attsync line because the source text height and width factor must be keep as is to fit within the specified block area when the text runs beyond the default for height and width.  Is there a way to also transfer the source value text height and width factor to the specified selected destination block tags?

[paullimapa]

Assuming attsync is not required to run first because the source inserted block attribute sequence still matches with the actual block definition, do all the Tags have unique height and width factors that need to be transferred or are there specific one or two that have this requirement?

[aamos]

Most of the tags have the default 0.08 for the height and 1.0 for the width. In some the attribute values from the old block DIEBORD there are some text values that have a different height and width. On the source block the prompts DESCRIPTION, and MATES W/ EXTRUSIONS, and source order numbers 19, 24, and 29 are the ones most likely to have a different height and width. 

It maybe easier just to have a default transfer of all the source block text value height and width because the source and destination block are mostly visually identical and maintaining the source text height and width will always fit into the destination block.

[paullimapa · Accepted solution]

Attach revised MAV.lsp should transfer all matching source prompt/value height & width factors over to the destination tag/value height & width factors.

Hopefully without running ATTSYNC first would not be an issue with the Block Def Attrib order sequence vs the Inserted BLock Attrib order sequence.

[aamos]

Paul,

Thank you so much for the updated mav file. It now works as expected. While reviewing the lisp file I was able to learn how to get the value height and width factor form the source and replace in destination for the value height and width factor.  I'm grateful for the knowledge you've shared.