Copy Multiple Block Attributes from one block to another one click

[lamonmar]

I have a drawing that has two different blocks  (see attached), what I needed to do was transfer over the attributes of one block over to the other (both have different tags). For example copying over attributes in "rev0_date" from the first block tag over to "revslot1date" in the second block tag , I ran across some code in the forums that did just that created by Lee Mac.The problem with it is it only transfers one attribute over, I modified it a little but its still not exactly what I need.

 

The way it currently works is - It asks me to choose the first block with the attributes to copy, once selected it then asks me to choose the second block that will have the attributes pasted to it, once I've selected them, it then pastes the first specified tag attribute in the first block to the second, after that I have to repeat the process again, clicking the block with the attribute to copy and then choosing the second block to paste, I have to keep repeating these steps, clicking the first block then the second over and over until all the tag attributes have been copied over.

 

My question is how can I stop having click the first and then second block over and over again for each tag and instead only have to go through the process once (click first block, then second and then transfer all the attributes over at once). Here is my current code (sorry if its a mess I'm very new to this):

(defun c:blockswap ( / _SelectBlockWithTag a b des src tag ) (vl-load-com)

 (setq DAT1A "Rev0_Date"  ; Source Attribute Tag 1
       DES1A "Rev0_Desc"  ; Source Attribute Tag 2
       REV1A "Rev0"  ; Source Attribute Tag 3
       RDB1A "Rev0_Drawn_By"  ; Source Attribute Tag 4
      

       REV1B "RevSlot1Number" ; Destination Attribute Tag 3
       DES1B "RevSlot1Description"  ; Destination Attribute Tag 2 
       DAT1B "RevSlot1Date"  ; Destination Attribute Tag 1
       RDB1B "RevSlot1DrawnBy"  ; Destination Attribute Tag 4
          
 )

 (defun _SelectBlockWithTag ( tag / e a ) (setq tag (strcase tag))
   (while
     (progn (setvar 'ERRNO 0) (setq f (car (entsel (strcat "\nSelect Block with attribute " tag ": "))))
       (cond
         ( (= 7 (getvar 'ERRNO))
           (princ "\nMissed, Try Again.")
         )
         ( (not f)
           nil
         )
         ( (and
             (eq "INSERT" (cdr (assoc 0 (entget f))))
             (= 1 (cdr (assoc 66 (entget f))))
           )
           (if
             (not
               (setq z
                 (vl-some
                   (function
                     (lambda ( x )
                       (if (eq tag (strcase (vla-get-tagstring x))) x)
                     )
                   )
                   (vlax-invoke (vlax-ename->vla-object f) 'getattributes)
                 )
               )
             )
             (princ (strcat "\nBlock does not contain tag " tag "."))
           )
         )
         ( (princ "\nInvalid Object Selected.") )
       )
     )
   )
   z
 )

 
   (and
     (setq aa (_SelectBlockWithTag DAT1A))
     (setq ab (_SelectBlockWithTag DAT1B))

    )
    
   (vla-put-textstring ab (vla-get-textstring aa))

   (and
     (setq ba (_SelectBlockWithTag DES1A))
     (setq bb (_SelectBlockWithTag DES1B))
    )

   (vla-put-textstring bb (vla-get-textstring ba))

   (and
     (setq ca (_SelectBlockWithTag REV1A))
     (setq cb (_SelectBlockWithTag REV1B))
    )

   (vla-put-textstring cb (vla-get-textstring ca)) 

   (and
     (setq da (_SelectBlockWithTag RDB1A))
     (setq db (_SelectBlockWithTag RDB1B))
    )

   (vla-put-textstring db (vla-get-textstring da))
(princ)
)

 

drawing.dwg

[BIGAL]

You need a repeat list for the two block att tags.

 

So start with tag1 then loops through block 2 checking atts if = tagname then up date. Then tag2 go through atts again until end of list.

 

; an example
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 0 )) 'getattributes)
        (if (= oldtag1 (strcase (vla-get-tagstring att)))
        (vla-put-textstring att newstr1) ; newstr1 this would be string value of current attribute
        ) ; end if
)

 

Edited December 6, 2019 by BIGAL

[Lee Mac]

You can achieve this with relatively few lines of code by making use of my Get Attribute Values & Set Attribute Values functions, as part of my Attribute Functions library.

 

For example, consider the following code:

(defun c:mapatts ( / dst map src )

    (setq map
       '(
        ;;    OLD_TAG    .  NEW_TAG
            ("REV0_DATE" . "REVSLOT1DATE")
        )
    )

    (defun selectattributedblock ( msg / ent enx )
        (while
            (progn (setvar 'errno 0) (setq ent (car (entsel msg)))
                (cond
                    (   (= 7 (getvar 'errno))
                        (princ "\nMissed, try again.")
                    )
                    (   (null ent)
                        nil
                    )
                    (   (/= "INSERT" (cdr (assoc 0 (setq enx (entget ent)))))
                        (princ "\nThe selected object is not a block.")
                    )
                    (   (/= 1 (cdr (assoc 66 enx)))
                        (princ "\nThe selected block is not attributed.")
                    )
                )
            )
        )
        ent
    )

    (if (and (setq src (selectattributedblock "\nSelect source block: "))
             (setq dst (selectattributedblock "\nSelect target block: "))
        )
        (LM:setattributevalues dst
            (mapcar '(lambda ( x ) (cons (cond ((cdr (assoc (car x) map))) ((car x))) (cdr x)))
                (LM:getattributevalues src)
            )
        )
    )
    (princ)
)

;; Get Attribute Values  -  Lee Mac
;; Returns an association list of attributes present in the supplied block.
;; blk - [ent] Block (Insert) Entity Name
;; Returns: [lst] Association list of ((<tag> . <value>) ... )

(defun LM:getattributevalues ( blk / enx lst )
    (while (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (setq lst
            (cons
                (cons
                    (cdr (assoc 2 enx))
                    (cdr (assoc 1 (reverse enx)))
                )
                lst
            )
        )
    )
    (reverse lst)
)

;; Set Attribute Values  -  Lee Mac
;; Sets attributes with tags found in the association list to their associated values.
;; blk - [ent] Block (Insert) Entity Name
;; lst - [lst] Association list of ((<tag> . <value>) ... )
;; Returns: nil

(defun LM:setattributevalues ( blk lst / enx itm )
    (while (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (if
            (and
                (setq itm (assoc (cdr (assoc 2 enx)) lst))
                (entmod (subst (cons 1 (cdr itm)) (assoc 1 (reverse enx)) enx))
            )
            (entupd blk)
        )
    )
    nil
)

(princ)

Here, you can populate the list at the top of the code with dotted pairs mapping the old attribute tags to their corresponding attribute tags within the new block (note that these are case-sensitive), per the existing example provided.

 

The program will then extract the existing attribute tags & values from the selected source block, 'translate' the names of those attribute tags which in the list at the top of the program, and then populate all matching attributes in the target block.

Edited December 6, 2019 by Lee Mac

[lamonmar]

Thank You Lee, That's exactly what i needed!

[RLim]

Hi,

Is it possible to link the attributes between to blocks? so i need to change only in one block?

[Steven P]

17 hours ago, RLim said:

Hi,

Is it possible to link the attributes between to blocks? so i need to change only in one block?

 

It's not something I have come across before - someone might have - though a simple solution might be to have each 'attribute' as a separate block, and inserted into each block as required -update that sub-block text and it will update in all other blocks. Lee Macs CTX function could be used I think to copy existing text into the sub-block without going through the block editor, and I have somewhere a LISP that will edit block text from the command line - will try to remember to find that on Monday.

 

 

Not sure if fields will work - not something I use often, maybe you can link them?

[BIGAL]

Yes, you can use fields so block 2 attribute has the value from a block 1 attribute. You can not cheat and copy the 2 blocks as the field is hard coded for the very 1st attributes picked. 

 

Is this for title  blocks say copied in multi layouts have something else to do that. "Update atts all layouts.lsp"