Change Attribute Tags for Blocks using Lisp

February 23, 2017

When I run the code below it lets me load and enter the command, but it doesn't change anything. There are no errors. I only edited the spot of the "old tag" and the "new tag" to my required values.

Is there something else I am missing here?

I need to change the values of multiple attribute tags to the same value on a large number of different blocks permanantly.

Thanks,

I read 5 minutes ago that attribute tags are unchangable without exploding.

Then I found a lisp which completely disproves that statement, and I'm damn pleased I found it.

If you ever want to change the tag names for attributed blocks use the following, creating a list of old & new tag names.

(defun c:attr_rename_list (  / x_en enn edd ss slen ix atnam 
          namelist hit blk_ent
          matchname newed x) 
 ; Process all block instances on active drawing. Check each 
 ; attribute for match on first element in list below. On any
 ; match, rename the attribute to the new name given in the
 ; second element. 

 ; ***********   ATTRIBUTE OLD versus NEW names list   ******************
 (setq namelist (list
     ; list old name and new name. Old name can contain wild cards.
     (list "OLD_TAG_NAME#1" "NEW_TAG_NAME#1")  ; list old name and new name. 
     (list "OLD_TAG_NAME#2" "NEW_TAG_NAME#2")
     (list "OLD_TAG_NAME#3" "NEW_TAG_NAME#3")
     (list "OLD_TAG_NAME#4" "NEW_TAG_NAME#4")
     (list "OLD_TAG_NAME#5" "NEW_TAG_NAME#5")
 ) )  
 ; **********************************************************************

 ; Extract selection set of all block inserts on active drawing  
 (setq ss (ssget "_X" '((0 . "INSERT"))))
 (if (/= ss nil)
   (progn
     (setq slen (sslength ss))
     (setq ix 0)
     (while (< ix slen)
       (setq blk_ent (ssname ss ix)) ; get next block insert to process        
       (setq ix (1+ ix)) ; increment for next time
       (setq enn (entnext blk_ent)) 
       (setq edd (entget enn))  
       (while (AND enn (/= (cdr (assoc 0 edd)) "SEQEND") 
                           (/= (cdr (assoc 0 edd)) "INSERT") )
         (if (= (cdr (assoc 0 edd)) "ATTRIB")
           (progn
             (setq atnam (cdr (assoc 2 edd)))
             (setq hit nil)
             (foreach x namelist
               (if (not hit)
                 (progn ; no match yet, keep processing
                   (setq matchname (car x))                
                   (if (wcmatch atnam matchname) 
                     (progn ; found exact match or wild-card match
                       ; Change name now. Substitute in new name.
                       (setq newed (subst (cons 2 (cadr x)) (assoc 2 edd) edd)) 
                       (entmod newed) ; update the title block instance
                       (entupd blk_ent) 
                       (princ "\n")
                       (princ atnam)
                       (princ " --> ")
                       (princ (cadr x))
                       (setq hit 1) ; flag that found
               ) ) ) )
             )
           )
         )     
         ; go to next sub ent in block instance and loop back up
         (if (setq enn (entnext enn)) (setq edd (entget enn))) 
     ) ) 
     (setq ss nil) ; release the selection set
   )
 )
 (princ) ; prettier
)

I love finding the answer. It makes me feel alive.

February 23, 2017

I would suggest just listing all the attributes that require changing on the left, and then it's okay to have a repeated value, if they all need to be changed to the same thing.

It should work. Here is the original code that I found and then used to input OLD/NEW attribute titles:

(defun c:attr_rename_list (  / x_en enn edd ss slen ix atnam 
          namelist hit blk_ent
          matchname newed x) 

 ; Process all block instances on active drawing. Check each 
 ; attribute for match on first element in list below. On any
 ; match, rename the attribute to the new name given in the
 ; second element. 

 ; ***********   ATTRIBUTE OLD versus NEW names list   ******************
 (setq namelist (list
     ; list old name and new name. Old name can contain wild cards.
     (list "format" "S")  ; list old name and new name. 
     (list "fail_type" "I")
 ) )  
 ; **********************************************************************
 
 ; Extract selection set of all block inserts on active drawing  
 (setq ss (ssget "_X" '((0 . "INSERT"))))
 (if (/= ss nil)
   (progn
     (setq slen (sslength ss))
     (setq ix 0)
     (while (< ix slen)
       (setq blk_ent (ssname ss ix)) ; get next block insert to process        
       (setq ix (1+ ix)) ; increment for next time
       (setq enn (entnext blk_ent)) 
       (setq edd (entget enn))  
       (while (AND enn (/= (cdr (assoc 0 edd)) "SEQEND") 
                           (/= (cdr (assoc 0 edd)) "INSERT") )
         (if (= (cdr (assoc 0 edd)) "ATTRIB")
           (progn
             (setq atnam (cdr (assoc 2 edd)))
             (setq hit nil)
             (foreach x namelist
               (if (not hit)
                 (progn ; no match yet, keep processing
                   (setq matchname (car x))                
                   (if (wcmatch atnam matchname) 
                     (progn ; found exact match or wild-card match
                       ; Change name now. Substitute in new name.
                       (setq newed (subst (cons 2 (cadr x)) (assoc 2 edd) edd)) 
                       (entmod newed) ; update the title block instance
                       (entupd blk_ent) 
                       (princ "\n")
                       (princ atnam)
                       (princ " --> ")
                       (princ (cadr x))
                       (setq hit 1) ; flag that found
               ) ) ) )
             )
           )
         )     
         ; go to next sub ent in block instance and loop back up
         (if (setq enn (entnext enn)) (setq edd (entget enn))) 
     ) ) 
     (setq ss nil) ; release the selection set
   )
 )
 (princ) ; prettier

Edited February 24, 2017 by SLW210
Added Code Tags

February 27, 2017

Hmmmm, well not sure why it's not working. I tried the both codes again with only one block in a new drawing. I even tried changing the tag to match the one in the codes and still no dice. The programs load OK and they run with no errors. I tried to attsync and then looked in the block and nothing changes.

Can anyone take a look at the code for me? I am not very knowledgeable in lisp routines. Thanks,

I would suggest just listing all the attributes that require changing on the left, and then it's okay to have a repeated value, if they all need to be changed to the same thing.

It should work. Here is the original code that I found and then used to input OLD/NEW attribute titles:

(defun c:attr_rename_list (  / x_en enn edd ss slen ix atnam 
          namelist hit blk_ent
          matchname newed x) 

 ; Process all block instances on active drawing. Check each 
 ; attribute for match on first element in list below. On any
 ; match, rename the attribute to the new name given in the
 ; second element. 

 ; ***********   ATTRIBUTE OLD versus NEW names list   ******************
 (setq namelist (list
     ; list old name and new name. Old name can contain wild cards.
     (list "format" "S")  ; list old name and new name. 
     (list "fail_type" "I")
 ) )  
 ; **********************************************************************
 
 ; Extract selection set of all block inserts on active drawing  
 (setq ss (ssget "_X" '((0 . "INSERT"))))
 (if (/= ss nil)
   (progn
     (setq slen (sslength ss))
     (setq ix 0)
     (while (< ix slen)
       (setq blk_ent (ssname ss ix)) ; get next block insert to process        
       (setq ix (1+ ix)) ; increment for next time
       (setq enn (entnext blk_ent)) 
       (setq edd (entget enn))  
       (while (AND enn (/= (cdr (assoc 0 edd)) "SEQEND") 
                           (/= (cdr (assoc 0 edd)) "INSERT") )
         (if (= (cdr (assoc 0 edd)) "ATTRIB")
           (progn
             (setq atnam (cdr (assoc 2 edd)))
             (setq hit nil)
             (foreach x namelist
               (if (not hit)
                 (progn ; no match yet, keep processing
                   (setq matchname (car x))                
                   (if (wcmatch atnam matchname) 
                     (progn ; found exact match or wild-card match
                       ; Change name now. Substitute in new name.
                       (setq newed (subst (cons 2 (cadr x)) (assoc 2 edd) edd)) 
                       (entmod newed) ; update the title block instance
                       (entupd blk_ent) 
                       (princ "\n")
                       (princ atnam)
                       (princ " --> ")
                       (princ (cadr x))
                       (setq hit 1) ; flag that found
               ) ) ) )
             )
           )
         )     
         ; go to next sub ent in block instance and loop back up
         (if (setq enn (entnext enn)) (setq edd (entget enn))) 
     ) ) 
     (setq ss nil) ; release the selection set
   )
 )
 (princ) ; prettier

February 27, 2017

@MACNEIL:

Do you want to change tagstrings or textstrings (= attribute values)?

The code is for the first. Note that tagstrings are in caps.

February 27, 2017

I am trying to change the tagstrings. As in the definition of the attribute, maybe this isn't the right program? See attached.

February 28, 2017

@MACNEIL:

Change the tagstrings in the namelist to upper case.

If that does not help post a dwg.

February 28, 2017

I tried yesterday with capitals and just to be sure I tried again today.

I made a brand new drawing with a new block and def and still get the same result.

Here's the CAD file. Thanks.

TEST2.dwg

@MACNEIL:
Change the tagstrings in the namelist to upper case.

If that does not help post a dwg.

February 28, 2017

Your problem is caused by the '#' character which is a special wcmatch character that matches any single digit:

(wcmatch "OLD_TAG_NAME#1" "OLD_TAG_NAME#1")  => nil
(wcmatch "OLD_TAG_NAME01" "OLD_TAG_NAME#1")  => T
(wcmatch "OLD_TAG_NAME11" "OLD_TAG_NAME#1")  => T
...
(wcmatch "OLD_TAG_NAME91" "OLD_TAG_NAME#1")  => T 
(wcmatch "OLD_TAG_NAME#1" "OLD_TAG_NAME`#1") => T (escaped special character)

This easiest fix is to replace:

(wcmatch atnam matchname)

with:

(= atnam matchname)

March 3, 2017

Hey,

Sorry haven't had a chance to try this out until just now.

I cannot get this to work still. I am more than likely misunderstanding something. Can you please take a look?

(defun c:attr_rename_list (  / x_en enn edd ss slen ix atnam 
          namelist hit blk_ent
          matchname newed x) 
 ; Process all block instances on active drawing. Check each 
 ; attribute for match on first element in list below. On any
 ; match, rename the attribute to the new name given in the
 ; second element. 

 ; ***********   ATTRIBUTE OLD versus NEW names list   ******************
 (setq namelist (list
     ; list old name and new name. Old name can contain wild cards.
(wcmatch "ITEM\U+0020#" "OLD_TAG_NAME#1")  => nil
(wcmatch "OLD_TAG_NAME01" "OLD_TAG_NAME#1")  => T
(wcmatch "OLD_TAG_NAME11" "OLD_TAG_NAME#1")  => T
...
(wcmatch "OLD_TAG_NAME91" "OLD_TAG_NAME#1")  => T 
(wcmatch "OLD_TAG_NAME#1" "OLD_TAG_NAME`#1") => T (escaped special character)
 ) )  
 ; **********************************************************************

 ; Extract selection set of all block inserts on active drawing  
 (setq ss (ssget "_X" '((0 . "INSERT"))))
 (if (/= ss nil)
   (progn
     (setq slen (sslength ss))
     (setq ix 0)
     (while (< ix slen)
       (setq blk_ent (ssname ss ix)) ; get next block insert to process        
       (setq ix (1+ ix)) ; increment for next time
       (setq enn (entnext blk_ent)) 
       (setq edd (entget enn))  
       (while (AND enn (/= (cdr (assoc 0 edd)) "SEQEND") 
                           (/= (cdr (assoc 0 edd)) "INSERT") )
         (if (= (cdr (assoc 0 edd)) "ATTRIB")
           (progn
             (setq atnam (cdr (assoc 2 edd)))
             (setq hit nil)
             (foreach x namelist
               (if (not hit)
                 (progn ; no match yet, keep processing
                   (setq matchname (car x))                
                   (if (atnam matchname) 
                     (progn ; found exact match or wild-card match
                       ; Change name now. Substitute in new name.
                       (setq newed (subst (cons 2 (cadr x)) (assoc 2 edd) edd)) 
                       (entmod newed) ; update the title block instance
                       (entupd blk_ent) 
                       (princ "\n")
                       (princ atnam)
                       (princ " --> ")
                       (princ (cadr x))
                       (setq hit 1) ; flag that found
               ) ) ) )
             )
           )
         )     
         ; go to next sub ent in block instance and loop back up
         (if (setq enn (entnext enn)) (setq edd (entget enn))) 
     ) ) 
     (setq ss nil) ; release the selection set
   )
 )
 (princ) ; prettier
)

Also I use the unicode for space in some of my tags. Will this mess this up?

Thanks!

Your problem is caused by the '#' character which is a special wcmatch character that matches any single digit:
(wcmatch "OLD_TAG_NAME#1" "OLD_TAG_NAME#1")  => nil
(wcmatch "OLD_TAG_NAME01" "OLD_TAG_NAME#1")  => T
(wcmatch "OLD_TAG_NAME11" "OLD_TAG_NAME#1")  => T
...
(wcmatch "OLD_TAG_NAME91" "OLD_TAG_NAME#1")  => T 
(wcmatch "OLD_TAG_NAME#1" "OLD_TAG_NAME`#1") => T (escaped special character)
This easiest fix is to replace:
(wcmatch atnam matchname)
with:
(= atnam matchname)

March 3, 2017

(defun c:attr_rename_list ( / elst enm i new nmeLst old ss)

 (setq nmeLst ; All tags must be upper case.
   (list
     ;     OLD                                     NEW
     (list "TAGWITH\U+00A0UNICODENONBREAKINGSPACE" "S") ; \U+00A0 = Unicode non-breaking space.
     (list "TAG2"                                  "I")
   )
 )

 (if (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
   (repeat (setq i (sslength ss))
     (setq enm (ssname ss (setq i (1- i))))
     (while
       (and
         (setq enm (entnext enm))
         (setq elst (entget enm))
         (= "ATTRIB" (cdr (assoc 0 elst)))
       )
       (if (setq new (cadr (assoc (setq old (cdr (assoc 2 elst))) nmeLst)))
         (progn
           (entmod (subst (cons 2 new) (cons 2 old) elst))
           (princ (strcat "\n" old " --> " new " "))
         )
       )
     )
   )
 )
 (princ)
)

Edited March 3, 2017 by Roy_043
Cleaned up the code.

March 7, 2017

@Roy_043

Everything is working great now, except a major problem.

This is not a permanent solution, because soon as I attsync the attribute value reverts back to the original. Is there a way to do this to the tag name inside of the block?

Mod please disregard my last post.

Thanks you.

(defun c:attr_rename_list ( / elst enm i new nmeLst old ss)

 (setq nmeLst ; All tags must be upper case.
   (list
     ;     OLD                                     NEW
     (list "TAGWITH\U+00A0UNICODENONBREAKINGSPACE" "S") ; \U+00A0 = Unicode non-breaking space.
     (list "TAG2"                                  "I")
   )
 )

 (if (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
   (repeat (setq i (sslength ss))
     (setq enm (ssname ss (setq i (1- i))))
     (while
       (and
         (setq enm (entnext enm))
         (setq elst (entget enm))
         (= "ATTRIB" (cdr (assoc 0 elst)))
       )
       (if (setq new (cadr (assoc (setq old (cdr (assoc 2 elst))) nmeLst)))
         (progn
           (entmod (subst (cons 2 new) (cons 2 old) elst))
           (princ (strcat "\n" old " --> " new " "))
         )
       )
     )
   )
 )
 (princ)
)

March 7, 2017

(defun c:AttRenList ( / doc new tagLst)

 (setq tagLst ; All tags must be upper case.
   (list
     ;     OLD                                     NEW
     (list "TAGWITH\U+00A0UNICODENONBREAKINGSPACE" "S") ; \U+00A0 = Unicode non-breaking space.
     (list "TAG2"                                  "I")
   )
 )

 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (vlax-for blk (vla-get-blocks doc)
   (if (= :vlax-false (vla-get-isxref blk))
     (vlax-for obj blk
       (cond
         ((= "AcDbBlockReference" (vla-get-objectname obj))
           (if (= :vlax-true (vla-get-hasattributes obj))
             (foreach att (vlax-invoke obj 'getattributes)
               (if (setq new (cadr (assoc (vla-get-tagstring att) tagLst)))
                 (vla-put-tagstring att new)
               )
             )
           )

         )
         ((= "AcDbAttributeDefinition" (vla-get-objectname obj))
           (if (setq new (cadr (assoc (vla-get-tagstring obj) tagLst)))
             (vla-put-tagstring obj new)
           )
         )
       )
     )
   )
 )
 (vla-endundomark doc)
 (princ)
)

March 8, 2017

@ROY_043

You're the man. Thanks a lot buddy.

June 2, 2023

On 8/9/2010 at 10:20 AM, hosannabizarre said:

(defun c:attr_rename_list (  / x_en enn edd ss slen ix atnam 
          namelist hit blk_ent
          matchname newed x) 
 ; Process all block instances on active drawing. Check each 
 ; attribute for match on first element in list below. On any
 ; match, rename the attribute to the new name given in the
 ; second element. 

 ; ***********   ATTRIBUTE OLD versus NEW names list   ******************
 (setq namelist (list
     ; list old name and new name. Old name can contain wild cards.
     (list "OLD_TAG_NAME#1" "NEW_TAG_NAME#1")  ; list old name and new name. 
     (list "OLD_TAG_NAME#2" "NEW_TAG_NAME#2")
     (list "OLD_TAG_NAME#3" "NEW_TAG_NAME#3")
     (list "OLD_TAG_NAME#4" "NEW_TAG_NAME#4")
     (list "OLD_TAG_NAME#5" "NEW_TAG_NAME#5")
 ) )  
 ; **********************************************************************

 ; Extract selection set of all block inserts on active drawing  
 (setq ss (ssget "_X" '((0 . "INSERT"))))
 (if (/= ss nil)
   (progn
     (setq slen (sslength ss))
     (setq ix 0)
     (while (< ix slen)
       (setq blk_ent (ssname ss ix)) ; get next block insert to process        
       (setq ix (1+ ix)) ; increment for next time
       (setq enn (entnext blk_ent)) 
       (setq edd (entget enn))  
       (while (AND enn (/= (cdr (assoc 0 edd)) "SEQEND") 
                           (/= (cdr (assoc 0 edd)) "INSERT") )
         (if (= (cdr (assoc 0 edd)) "ATTRIB")
           (progn
             (setq atnam (cdr (assoc 2 edd)))
             (setq hit nil)
             (foreach x namelist
               (if (not hit)
                 (progn ; no match yet, keep processing
                   (setq matchname (car x))                
                   (if (wcmatch atnam matchname) 
                     (progn ; found exact match or wild-card match
                       ; Change name now. Substitute in new name.
                       (setq newed (subst (cons 2 (cadr x)) (assoc 2 edd) edd)) 
                       (entmod newed) ; update the title block instance
                       (entupd blk_ent) 
                       (princ "\n")
                       (princ atnam)
                       (princ " --> ")
                       (princ (cadr x))
                       (setq hit 1) ; flag that found
               ) ) ) )
             )
           )
         )     
         ; go to next sub ent in block instance and loop back up
         (if (setq enn (entnext enn)) (setq edd (entget enn))) 
     ) ) 
     (setq ss nil) ; release the selection set
   )
 )
 (princ) ; prettier
)

I love finding the answer. It makes me feel alive.

This was great to find and solved some of my problems. Is there a way to make it change attribute name only on a certain blockname?

Sign In

Change Attribute Tags for Blocks using Lisp

Recommended Posts

MACNEIL

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

hosannabizarre

MACNEIL

Roy_043

MACNEIL

Roy_043

MACNEIL

Roy_043

MACNEIL

Roy_043

MACNEIL

Roy_043

MACNEIL

Matlin0

Join the conversation

Tutorials

Forums

Activity