Copy attribute value between two blocks (different tags)

[itacad]

Hello, I found a lot of lisp for copy attributes from a bloch to another but usually the operation is applied to two equal blocks.

I have 2 sets of different blocks, structured in the same way:

- From the first series of blocks I need the attribute with the tag SIGLA (whatever the name of the block)

- From the second set of blocks I need the attribute with the tag NAME (whatever the name of the block)

The next description holds in both directions.

I would like to select any block with attribute with SIGLA tag, acquire its value and copy it in any block with NAME tag attribute even if not compiled.

I'd like to just click on the blocks.

Have you ever seen / developed something like this?

Thanks in advance

[Emmanuel Delay]

This script does what you require, if your attributes are visible.  For example set every NAME attribute to "." ,  just so you can select it as target. (which might not be practical to you, not sure)

 

 

 

But I'll see if I can make it fit your specific purpose.

[Emmanuel Delay]

This should work

Command TTCB , but please feel free to rename this

 

(vl-load-com)

;; To copy/paste from fixed attributes, source tag:  "SIGLA",  destination tag:  "NAME"
;; TTC Block
(defun c:ttcb ( / sText)
  (defun TCC_copyAttribute (source / blk )
    (if (setq blk (entsel "\nSelect source block: "))
	  (setq sText (LM:vl-getattributevalue (vlax-ename->vla-object (car blk)) source))
	)
  )
  (defun TCC_pasteAttribute (dest / blk)
    (if (setq blk (entsel "\nSelect destination block: "))
	  (LM:vl-setattributevalues (vlax-ename->vla-object (car blk)) (list (cons dest sText))  )
	)
  ) 
  
  (while (TCC_copyAttribute  "SIGLA")
    (TCC_pasteAttribute  "NAME")
  )
  
) 

;; Get Attribute Value  -  Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.
(defun LM:vl-getattributevalue ( blk tag )
    (setq tag (strcase tag))
    (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
)

;; Set Attribute Values  -  Lee Mac
;; Sets attributes with tags found in the association list to their associated values.
;; blk - [vla] VLA Block Reference Object
;; lst - [lst] Association list of ((<tag> . <value>) ... )
;; Returns: nil
(defun LM:vl-setattributevalues ( blk lst / itm )
    (foreach att (vlax-invoke blk 'getattributes)
        (if (setq itm (assoc (vla-get-tagstring att) lst))
            (vla-put-textstring att (cdr itm))
        )
    )
)

 

Edited September 11, 2018 by Emmanuel Delay

[BIGAL]

Here is a start allows picking an attribute directly returning tag name and block name

 

(setq ans  (entget (car (nentsel "pick block 1"))))
(setq tag1 (cdr (assoc 2 ans)))
(setq obj (vlax-ename->vla-object (cdr(assoc 330 ans))))
(setq blk1 (vla-get-EffectiveName obj))
(setq ans  (entget (car (nentsel "pick block 2"))))
(setq tag2 (assoc ans))
(setq obj (vlax-ename->vla-object (cdr(assoc 330 ans))))
(setq blk2 (vla-get-EffectiveName obj))

[itacad]

Hi Emmanuel Delay, unfortunately, the lisp ttc is not suitable in this case because precisely, the destination attributes could be invisible or not compiled (the result is that I have nothing to click on if not the block)

 

For Bigal: in your code there aren't the specified attribute's tag (SIGLA and NAME) why?

[BIGAL]

That's the idea of the code, using nentsel returns the attribute tag name, I need to change to "Pick block1 Attribute" "Pick block 2 Attribute"

 

There

 

add

Code updated in prior post mistake fixed also

(setq ans  (entget (car (nentsel "pick block 1 attribute"))))
(setq tag1 (cdr (assoc 2 ans)))
(setq obj (vlax-ename->vla-object (cdr(assoc 330 ans))))
(setq blk1 (vla-get-EffectiveName obj))
(setq ans  (entget (car (nentsel "pick block 2 attribute"))))
(setq tag2 (cdr (assoc 2 ans)))
(setq obj (vlax-ename->vla-object (cdr(assoc 330 ans))))
(setq blk2 (vla-get-EffectiveName obj))
(alert (strcat "You picked block1 \ntagname = " tag1 "\nName =" blk1 "\nYou picked block 2  \ntagname = " tag2 "\nName =" blk2 ))

 

Edited September 12, 2018 by BIGAL

[Emmanuel Delay]

10 hours ago, itacad said:

Hi Emmanuel Delay, unfortunately, the lisp ttc is not suitable in this case because precisely, the destination attributes could be invisible or not compiled (the result is that I have nothing to click on if not the block) 

  

For Bigal: in your code there aren't the specified attribute's tag (SIGLA and NAME) why? 

 

Well yes, exactly why I wrote that second reply. 

With TTCB you click on the block, any part of the block

 

Edited September 12, 2018 by Emmanuel Delay

[BIGAL]

Your missing the point no hard coding of blocknames or tagnames, the next time you have to do this and use a different block name you have to edit the actual lisp file. The coding provides a universal answer rather 1 time only.

[maratovich]

itacad

To be precise and there is no error - attach a sample of your file with blocks.

[itacad]

I found the solution in your gigantic discussion archive

is it possible to make it work both ways?

Thank you very much

 

[whysoserious]

It's quite an old topic but I am still hoping for a reply. The code posted by Emmanuel Delay works perfectly but I am wondering if it's possible to be modified so that it extracts another 2 attributes tags (SIGLA1 and NAME1). I have managed to to do this, but only if i click "select source block" then "select destination block" then repeat this process. It might be a stupid question but can the copy/paste of another 2 attributes tags be achieved by selecting only once source and destination blocks? Many thanks.

TTCB.LSP

[Steven P]

Try this change to Emmanuel Delay - though he might have better ideas of course

 

The tags to change are in 2 lists - bit there is no checking that the 2 lists are the same length or valid attribute tags. As BigAl above, a more versatile approach might be select source, select tags, select destination, select tags - though that would need a bit more work to reduce user errors

 

 

(vl-load-com)
;; To copy/paste from fixed attributes, source tag:  "SIGLA",  destination tag:  "NAME"
;; TTC Block
(defun c:ttcb ( / sText)

;;ADDED SOURCE and DESTINATION 
(setq source_list (list "SIGLA" "SIGLA1"))
(setq final_destination (list "NAME" "NAME1"))

  (defun TCC_copyAttribute (source blk / )
;    (if (setq blk (entsel "\nSelect source block: ")) ;;REMOVED THIS LINE
	  (setq sText (LM:vl-getattributevalue (vlax-ename->vla-object (car blk)) source))
;	) ;; REMOVED THIS
  )
  (defun TCC_pasteAttribute (dest blk / )
;    (if (setq blk (entsel "\nSelect destination block: ")) ;; REMOVED THIS LINE
	  (LM:vl-setattributevalues (vlax-ename->vla-object (car blk)) (list (cons dest sText))  )
;	) ;;REMOVED THIS
  ) 
  
  (setq Source_blk (entsel "\nSelect source block: "))
  (setq Destination_blk (entsel "\nSelect destination block: "))  

  (setq acount 0)
  (while (< acount (length source_list))
;  (while (TCC_copyAttribute  "SIGLA")  ;;REMOVED THIS LINE
;    (TCC_pasteAttribute  "NAME")  ;;REMOVED THIS LINE
      (TCC_copyAttribute (nth acount source_list) Source_blk )
      (TCC_pasteAttribute (nth acount final_destination) Destination_blk)
;    ) ; end while ;;REMOVED THIS LINE
    (setq acount (+ acount 1))
  ) ; end while
) 

;; Get Attribute Value  -  Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.
(defun LM:vl-getattributevalue ( blk tag )
    (setq tag (strcase tag))
    (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
)

;; Set Attribute Values  -  Lee Mac
;; Sets attributes with tags found in the association list to their associated values.
;; blk - [vla] VLA Block Reference Object
;; lst - [lst] Association list of ((<tag> . <value>) ... )
;; Returns: nil
(defun LM:vl-setattributevalues ( blk lst / itm )
    (foreach att (vlax-invoke blk 'getattributes)
        (if (setq itm (assoc (vla-get-tagstring att) lst))
            (vla-put-textstring att (cdr itm))
        )
    )
)

 

[whysoserious]

Thank you so much for your time Steven P, this is exactly what I was after. It works great. 

[Quango1]

Is there any way this can be edited so that the selected destination block is linked via a field? So if the first block is later amended it auto updates the second block?

[Steven P]

Probably.. but fields arn't my thing, someone else might know this one

[mhupp]

12 hours ago, Steven P said:

Probably.. but fields arn't my thing, someone else might know this one

 

and its the weekend now!

[BIGAL]

Try this select attributes. Did something similar yesterday so code was there.

 

;  https://www.cadtutor.net/forum/topic/65971-copy-attribute-value-between-two-blocks-different-tags/
(defun C:att2 (/ obj objID area hname content units)
	(setq obj (vlax-ename->vla-object (car (nentsel "\nSelect attribute "))))
	(setq objID (rtos (vla-get-objectid obj) 2 0))
	(setq atname (strcat "%<\\AcObjProp Object(%<\\_ObjId " objID ">%).Textstring>%"))
	(setq obj (vlax-ename->vla-object (car (nentsel "\nSelect attribute 2 "))))
	(vlax-put obj 'Textstring atname)
(princ)
)

 

[Quango1]

On 12/8/2023 at 4:53 PM, Steven P said:

Probably.. but fields arn't my thing, someone else might know this one

No Worries another question is it possible for this to also get the Easting & Northing from the selected block?

I'm not very good with lisps so not sure how to combine the attributes its reading as well as properties of the block