Copy all attributes...

No offense taken. ATM, I don't really have time to help.

Sounds like someone's got a "Case of the Monday's".

Sounds like someone's got a "Case of the Monday's".

LoL, probably. I spent a lot of my weekend marking items off the honey-do list and didn't spend much time in the woods.

LoL, probably. I spent a lot of my weekend marking items off the honey-do list and didn't spend much time in the woods.

If it will help, you can come to my place and we'll take a bat to one of my old printers.

We just moved before Christmas, so I have tons of stuff we could trash - if the printer isn't enough. You should see my honey-do list!

I hope you and 'The Ladies' had a great Christmas - belated Happy New Year to the Alanjt's!

Maybe I'll check if my man Lee Mac can check into this. I'm sure he's got something quick and easy under his sleeves!

I'm sure the rest of you guys could've coded this also - I'm just the mug who always gives the code away...

[color=RED]([/color][color=BLUE]defun[/color] CopyAttribs [color=RED]([/color] block1 block2 [color=BLUE]/[/color] ss1 ss2 [color=RED])[/color]

 [color=RED]([/color][color=BLUE]if[/color]
   [color=RED]([/color][color=BLUE]and[/color]
     [color=RED]([/color][color=BLUE]setq[/color] ss1 [color=RED]([/color][color=BLUE]ssget[/color] [color=#a52a2a]"_X"[/color] [color=RED]([/color][color=BLUE]list[/color] [color=RED]([/color][color=BLUE]cons[/color] [color=#009900]0[/color] [color=#a52a2a]"INSERT"[/color][color=RED])[/color] [color=RED]([/color][color=BLUE]cons[/color] [color=#009900]66[/color] [color=#009900]1[/color][color=RED])[/color] [color=RED]([/color][color=BLUE]cons[/color] [color=#009900]2[/color] block1[color=RED]))))[/color]
     [color=RED]([/color][color=BLUE]setq[/color] ss2 [color=RED]([/color][color=BLUE]ssget[/color] [color=#a52a2a]"_X"[/color] [color=RED]([/color][color=BLUE]list[/color] [color=RED]([/color][color=BLUE]cons[/color] [color=#009900]0[/color] [color=#a52a2a]"INSERT"[/color][color=RED])[/color] [color=RED]([/color][color=BLUE]cons[/color] [color=#009900]66[/color] [color=#009900]1[/color][color=RED])[/color] [color=RED]([/color][color=BLUE]cons[/color] [color=#009900]2[/color] block2[color=RED]))))[/color]
   [color=RED])[/color]
   [color=RED]([/color]
     [color=RED]([/color][color=BLUE]lambda[/color] [color=RED]([/color] data [color=RED])[/color]
       [color=RED]([/color][color=BLUE]mapcar[/color]
         [color=RED]([/color][color=BLUE]function[/color]
           [color=RED]([/color][color=BLUE]lambda[/color] [color=RED]([/color] attrib [color=BLUE]/[/color] tag [color=RED])[/color]
             [color=RED]([/color][color=BLUE]if[/color] [color=RED]([/color][color=BLUE]setq[/color] tag [color=RED]([/color][color=BLUE]assoc[/color] [color=RED]([/color][color=BLUE]strcase[/color] [color=RED]([/color][color=BLUE]vla-get-TagString[/color] attrib[color=RED]))[/color] data[color=RED]))[/color]
               [color=RED]([/color][color=BLUE]vla-put-TextString[/color] attrib [color=RED]([/color][color=BLUE]cdr[/color] tag[color=RED]))[/color]
             [color=RED])[/color]
           [color=RED])[/color]
         [color=RED])[/color]
         [color=RED]([/color][color=BLUE]vlax-invoke[/color] [color=RED]([/color][color=BLUE]vlax-ename->vla-object[/color] [color=RED]([/color][color=BLUE]ssname[/color] ss2 [color=#009900]0[/color][color=RED]))[/color] [color=DARKRED]'[/color]GetAttributes[color=RED])[/color]
       [color=RED])[/color]
     [color=RED])[/color]
     [color=RED]([/color][color=BLUE]mapcar[/color]
       [color=RED]([/color][color=BLUE]function[/color]
         [color=RED]([/color][color=BLUE]lambda[/color] [color=RED]([/color] attrib [color=RED])[/color]
           [color=RED]([/color][color=BLUE]cons[/color] [color=RED]([/color][color=BLUE]strcase[/color] [color=RED]([/color][color=BLUE]vla-get-TagString[/color] attrib[color=RED]))[/color] [color=RED]([/color][color=BLUE]vla-get-TextString[/color] attrib[color=RED]))[/color]
         [color=RED])[/color]
       [color=RED])[/color]
       [color=RED]([/color][color=BLUE]vlax-invoke[/color] [color=RED]([/color][color=BLUE]vlax-ename->vla-object[/color] [color=RED]([/color][color=BLUE]ssname[/color] ss1 [color=#009900]0[/color][color=RED]))[/color] [color=DARKRED]'[/color]GetAttributes[color=RED])[/color]
     [color=RED])[/color]
   [color=RED])[/color]
 [color=RED])[/color]

 [color=RED]([/color][color=BLUE]princ[/color][color=RED])[/color]
[color=RED])[/color]

[color=red]([/color]CopyAttribs [color=darkred]"FromBlockname"[/color] [color=darkred]"ToBlockname"[/color][color=red])[/color]

Assumes only one block of each name exists in drawing.

..and has the time. :wink:

 

 

Slight mod (untested)...

(defun CopyAttribs (block1 block2 / ss1 ss2)
 (if (and
       (setq ss1 (ssget "_X" (list (cons 0 "INSERT") (cons 66 1) (cons 2 block1))))
       (setq ss2 (ssget "_X" (list (cons 0 "INSERT") (cons 66 1) (cons 2 block2))))
     )
   ((lambda (data i / e tag)
      (while (setq e (ssname ss (setq i (1+ i))))
        (foreach attrib (vlax-invoke (vlax-ename->vla-object e) 'GetAttributes)
          (if (setq tag (assoc (strcase (vla-get-TagString attrib)) data))
            (vla-put-TextString attrib (cdr tag))
          )
        )
      )
    )
     (mapcar
       (function
         (lambda (attrib) (cons (strcase (vla-get-TagString attrib)) (vla-get-TextString attrib)))
       )
       (vlax-invoke (vlax-ename->vla-object (ssname ss1 0)) 'GetAttributes)
     )
     -1
   )
 )
 (princ)
)

Dear Alan

I need a help from you to get the attribute value of a TAG.

The script I had made is pasted below. i hope you will understand what I am looking for.

Please give me solution at your earliest.

Thanks & Regards

Shyhas..

(defun c:SLD()

(setq osm (getvar "osmode"))

(setvar "osmode" 0)

(setq CP1 (getpoint "\nStart Point: "))

(setq CP2 (getpoint "\nEnd Point: "))

(setq eq1 (entsel "\nSelect first equipment: "))

(setq eqname1 (cdr (assoc 2 (entget (car eq1))))) filter the block name

; NEED THE FUNCTION.... get the attribute tag value of ETAG of the block eqname1

(setq eq2 (entsel "\nSelect second equipment: "))

(setq eqname2 (cdr (assoc 2 (entget (car eq2))))) filter the block name

; NEED THE FUNCTION.... get the attribute tag value of ETAG of the block eqname2

(command "line" CP1 CP2 "")

(setq CP3 (polar CP1 (angle CP1 CP2) (/ (distance CP1 CP2) 2)))

(command "_insert" "d:/stdBlk/Dyn/CTAG.dwg" CP3 1 1 "") ; insert the block

; NEEDED FUNCTION.... need to replace the tag FROM & TO of the inserted block CTAG.dwg from the data retrieved

; NEEDED FUNCTION.... from the tag ETAG of eqname1 & eqname2

(SETVAR "OSMODE" OSM)

)

CTAG.dwg

LIGHT 2x18.dwg

On 5/25/2010 at 2:35 PM, alanjt said:

(defun c:MAV (/ AT:GetSel obj ss u aLst lkLst)
 ;; Match Attribute Values (including objects on locked layers)
 ;; Alan J. Thompson, 05.25.10

 (vl-load-com)

 (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
   (setvar 'ERRNO 0)
   (while
     (progn (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 (setq obj (car (AT:Getsel entsel
                                    "\nSelect Attributed Block: "
                                    (lambda (x / e)
                                      (and (eq "INSERT" (cdr (assoc 0 (setq e (entget (car x))))))
                                           (eq 1 (cdr (assoc 66 e)))
                                      )
                                    )
                         )
                    )
          )
          (not (initget 0 "Yes No"))
          (setq *MAV:Choice*
                 (cond ((getkword (strcat "\nMatch ONLY selected block \""
                                          (vla-get-name (setq obj (vlax-ename->vla-object obj)))
                                          "\" [Yes/No] <"
                                          (cond (*MAV:Choice*)
                                                ((setq *MAV:Choice* "Yes"))
                                          )
                                          ">: "
                                  )
                        )
                       )
                       (*MAV:Choice*)
                 )
          )
          (setq ss (ssget (list '(0 . "INSERT")
                                '(66 . 1)
                                (cons 2
                                      (if (eq "Yes" *MAV:Choice*)
                                        (vla-get-name obj)
                                        "*"
                                      )
                                )
                          )
                   )
          )
     )
   (progn
     (setq u (not (vla-startundomark
                    (cond (*AcadDoc*)
                          ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
                    )
                  )
             )
     )
     (vlax-for la (vla-get-layers *AcadDoc*)
       (and (eq :vlax-true (vla-get-lock la))
            (setq lkLst (cons la lkLst))
            (vla-put-lock la :vlax-false)
       )
     )

     (foreach a (vlax-invoke obj 'GetAttributes)
       (setq aLst (cons (cons (vla-get-tagstring a) (vla-get-textstring a)) aLst))
     )

     (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
       (foreach a (vlax-invoke x 'GetAttributes)
         (if (setq att (cdr (assoc (vla-get-tagstring a) aLst)))
           (vla-put-textstring a att)
         )
       )
     )
     (vla-delete ss)

     (and lkLst (foreach l lkLst (vla-put-lock l :vlax-true)))

     (and u (vla-endundomark *AcadDoc*))
   )
 )
 (princ)
)

 

Hi Alan, I know this post is really old, but I found your code very helpful today and made a few modifications, so I thought it would be fair to put it here for anyone out there. 

Note: I'm a novice at autolisp, so it's pretty hacky, but it appears to work reliably.

These are the changes I made:

1) no prompt. ("no" every time) Copy attribute values to selected blocks even with different names (the attribute tags still have to be the same).

2) added compatibility with dynamic blocks.

3) changed named to ACC (attribute copy something..) so i could type it with my left hand and keep the right on the mouse

4) [optional] made it so that it would only copy the values of ONE ATTRIBUTE called "DEVICE_NAME". all other attributes left untouched. Anyone out there, feel free to change "DEVICE_NAME" on line 73 to any other attribute definition you like.

5) [optional] if you don't like (4), comment line 73 out, and uncomment line 72. This will copy the values of ALL ATTRIBUTES that have matching tag names. Note: the reason I went away from this is that it can overwrite the values of your fields (even on a frozen layer) and this was a big no no for me.

Here's the code, enjoy!:

(defun c:ACC (/ AT:GetSel obj ss u aLst lkLst)

 ;; Match Attribute Values (including objects on locked layers)

 ;; Alan J. Thompson, 05.25.10



 (vl-load-com)



 (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

   ;; Modified by Rory Cavanagh, 02.22.24 to copy values of all attributes of the same name to any other selected blocks

   (setvar 'ERRNO 0)

   (while

     (progn (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 (setq obj (car (AT:Getsel entsel

                                    "\nSelect Source Attributed Block: "

                                    (lambda (x / e)

                                      (and (eq "INSERT" (cdr (assoc 0 (setq e (entget (car x))))))

                                           (eq 1 (cdr (assoc 66 e)))

                                      )

                                    )

                         )

                    )

          )



      (cond (

          (setq obj (vlax-ename->vla-object obj))

          T

        )

      )

          (setq ss (ssget (list '(0 . "INSERT")

                                '(66 . 1)

        ;                        (cons 2 "*")

                          )

                   )

          )

     )

   (progn

     (setq u (not (vla-startundomark

                    (cond (*AcadDoc*)

                          ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))

                    )

                  )

             )

     )

     (vlax-for la (vla-get-layers *AcadDoc*)

       (and (eq :vlax-true (vla-get-lock la))

            (setq lkLst (cons la lkLst))

            (vla-put-lock la :vlax-false)

       )

     )



     (foreach a (vlax-invoke obj 'GetAttributes)

     ;(setq aLst (cons (cons (vla-get-tagstring a) (vla-get-textstring a)) aLst)) ;this line will copy the values of all matching tags--but beware! fields will be overwritten too, which, in the case of wire labels is a disaster

     (setq aLst (cons (cons (if (= (vla-get-tagstring a) "DEVICE_NAME") (vla-get-tagstring a) (strcat "nullifyTheTag" (vla-get-tagstring a))) (vla-get-textstring a)) aLst)) ;this line will only copy an attribute with the specified tag name. Annoyingly, i still had to create the list even if there were no matches...

     )


     (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))

       (foreach a (vlax-invoke x 'GetAttributes)

         (if (setq att (cdr (assoc (vla-get-tagstring a) aLst)))

           (vla-put-textstring a att)

         )

       )

     )

     (vla-delete ss)



     (and lkLst (foreach l lkLst (vla-put-lock l :vlax-true)))



     (and u (vla-endundomark *AcadDoc*))

   )

 )

 (princ)

)

Please use Code Tags. (<> in the editor toolbar)

On 2/21/2024 at 11:37 PM, Rory said:

 

 

Hi Alan, I know this post is really old, but I found your code very helpful today and made a few modifications, so I thought it would be fair to put it here for anyone out there. 

Note: I'm a novice at autolisp, so it's pretty hacky, but it appears to work reliably.

 

These are the changes I made:

1) no prompt. ("no" every time) Copy attribute values to selected blocks even with different names (the attribute tags still have to be the same).

2) added compatibility with dynamic blocks.

3) changed named to ACC (attribute copy something..) so i could type it with my left hand and keep the right on the mouse

4) [optional] made it so that it would only copy the values of ONE ATTRIBUTE called "DEVICE_NAME". all other attributes left untouched. Anyone out there, feel free to change "DEVICE_NAME" on line 73 to any other attribute definition you like.

5) [optional] if you don't like (4), comment line 73 out, and uncomment line 72. This will copy the values of ALL ATTRIBUTES that have matching tag names. Note: the reason I went away from this is that it can overwrite the values of your fields (even on a frozen layer) and this was a big no no for me.

 

Here's the code, enjoy!:

(defun c:ACC (/ AT:GetSel obj ss u aLst lkLst)

 ;; Match Attribute Values (including objects on locked layers)

 ;; Alan J. Thompson, 05.25.10



 (vl-load-com)



 (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

   ;; Modified by Rory Cavanagh, 02.22.24 to copy values of all attributes of the same name to any other selected blocks

   (setvar 'ERRNO 0)

   (while

     (progn (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 (setq obj (car (AT:Getsel entsel

                                    "\nSelect Source Attributed Block: "

                                    (lambda (x / e)

                                      (and (eq "INSERT" (cdr (assoc 0 (setq e (entget (car x))))))

                                           (eq 1 (cdr (assoc 66 e)))

                                      )

                                    )

                         )

                    )

          )



      (cond (

          (setq obj (vlax-ename->vla-object obj))

          T

        )

      )

          (setq ss (ssget (list '(0 . "INSERT")

                                '(66 . 1)

        ;                        (cons 2 "*")

                          )

                   )

          )

     )

   (progn

     (setq u (not (vla-startundomark

                    (cond (*AcadDoc*)

                          ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))

                    )

                  )

             )

     )

     (vlax-for la (vla-get-layers *AcadDoc*)

       (and (eq :vlax-true (vla-get-lock la))

            (setq lkLst (cons la lkLst))

            (vla-put-lock la :vlax-false)

       )

     )



     (foreach a (vlax-invoke obj 'GetAttributes)

     ;(setq aLst (cons (cons (vla-get-tagstring a) (vla-get-textstring a)) aLst)) ;this line will copy the values of all matching tags--but beware! fields will be overwritten too, which, in the case of wire labels is a disaster

     (setq aLst (cons (cons (if (= (vla-get-tagstring a) "DEVICE_NAME") (vla-get-tagstring a) (strcat "nullifyTheTag" (vla-get-tagstring a))) (vla-get-textstring a)) aLst)) ;this line will only copy an attribute with the specified tag name. Annoyingly, i still had to create the list even if there were no matches...

     )


     (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))

       (foreach a (vlax-invoke x 'GetAttributes)

         (if (setq att (cdr (assoc (vla-get-tagstring a) aLst)))

           (vla-put-textstring a att)

         )

       )

     )

     (vla-delete ss)



     (and lkLst (foreach l lkLst (vla-put-lock l :vlax-true)))



     (and u (vla-endundomark *AcadDoc*))

   )

 )

 (princ)

)

 

 

 

 

Glad it was useful to you and thank you for noting your modifications from the original.