Jump to content
hosannabizarre

Change Attribute Tags for Blocks using Lisp

Recommended Posts

hosannabizarre

I am pretty keen to know if it is possible to change attribute tag names using lisp (or some other strategy).

 

I have lots of different blocks, and they all have two attributes.

 

The tag for attribute 1 is "X", with a value of "100"

The tag for attribute 2 is "Y", with a value of "200"

 

Is is possible to change all the blocks in the drawing, such that the attribute 1 tag is renamed from "X" to "A", and the attribute 2 tag is renamed from "Y" to "B".

 

I would like, if possible, to preserve and leave unchanged the values associated with the respective attributes, and change only the tag. So basically, once the script is done, I will still have blocks with two attributes, one with the tag "A" and a value of "100", and another attribute with the tag "B" and the value of "200".

 

To clarify; I'm not interested in replacing attribute values, but rather changing attribute tag names.

 

Hope this is comprehensible to someone, and maybe even achievable.

 

:?

Share this post


Link to post
Share on other sites
BIGAL

Did you search the forum here first ? There is heaps of stuff to do with blocks I am sure there is a routine by some one like Lee Mac that does everything to a block in one lisp program. Attributes tags colour layer etc

Share this post


Link to post
Share on other sites
hosannabizarre

There is heaps on blocks and changing attribute values, but not so much on changing attribute tag names across multiple blocks within a drawing using an automated process.

 

I tried Lee Mac's code, which is here http://www.cadtutor.net/forum/showthread.php?46101-Change-Tag-names-in-attributed-block&highlight=change+attribute+tags

 

i.e.

 

(defun c:attupd (/ ss sel doc lst tag)
 (vl-load-com)

 (if (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
   (progn
     (vlax-for Obj (setq sel (vla-get-ActiveSelectionSet
                               (setq doc (vla-get-ActiveDocument
                                           (vlax-get-acad-object)))))
       (vlax-for Sub (vla-item
                       (vla-get-Blocks doc)
                         (vla-get-Name Obj))

         (if (eq "AcDbAttributeDefinition"
               (vla-get-ObjectName Sub))
           (setq lst
             (cons
               (cons
                 (vla-get-TagString Sub)
                   (vl-list->string
                     (subst 95 32
                       (vl-string->list
                         (vla-get-PromptString Sub))))) lst))))

       (foreach att (vlax-invoke Obj 'GetAttributes)
         (if (setq tag (assoc (vla-get-TagString att) lst))
           (vla-put-TagString att (cdr tag))))

       (setq lst nil))

     (vla-delete sel))

   (princ "\n** No Attributed Blocks Found **"))
 (princ))

 

 

 

I can't get this to work, unfortunately. Not sure what I'd need to modify to make in work in my situation.

 

Cheers

Share this post


Link to post
Share on other sites
hosannabizarre

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.:D

Edited by hosannabizarre

Share this post


Link to post
Share on other sites
CADkitt

I modified that script so I can change the tags of old blocks to the new tags and replace the block with the new block. Also scale the new block to the correct size. And delete any blocks that where not needed any more.

Since I know how pain in the ass work this is..... here is the script:

(I btw cleaned it up a bit hope I didn't removed any stuff that wasn't supposed to be removed :P)

defun changeblock (/ BLK DOC I TAGLST SS)
 (vl-load-com)
 (setq blk "OLDNAMEOFBLOCK"
   tagLst '(
        ;"Old Tag"    "New Tag"
 ("OLDTAG"    	"NEWTAG")
        )
   i -1
   doc (vla-get-activedocument (vlax-get-acad-object))
   )
 (if (ssget "_X" (list (cons 0 "INSERT")(cons 2 blk)))
   (vlax-for bl (setq ss (vla-get-activeselectionset doc))
     (foreach att (vlax-invoke bl 'getAttributes)
   (If (assoc (vla-get-tagstring att) tagLst)
     (vla-put-tagstring att (cadr (assoc (vla-get-tagstring att) tagLst)))
     )))
   (princ "\nNo part rule Found."))
 (princ)
 (progn
   (if (tblsearch "BLOCK" "OLDNAMEOFBLOCK")
  (progn
 	(command "-rename" "b" "OLDNAMEOFBLOCK" "NEWNAMEOFBLOCK")
 	(command "_.-insert" "NEWNAMEOFBLOCK=FILENAME" "y" nil);replaced convert template to new template.
(command "_.attsync" "n" "NEWNAMEOFBLOCK")
(scl 0.8 "NEWNAMEOFBLOCK");scales block to new scale
  (blknr13 "NEWNAMEOFBLOCK"); this was command to set a block the a layer. (not included can eb removed)
))      	    
 )(princ)(princ "succes!")(princ)
 )
;; Run program manually with this:
(defun c:Chblock () (changeblock))
;;itemline

;; Scale the old template to new one
(defun scl (xsc blk / ss)
 (vl-load-com)
 (if (setq SS (ssget "_X" (list '(0 . "INSERT") (cons 2 blk))))
   (mapcar
     (function
       (lambda (Obj)
         (vla-ScaleEntity Obj
           (vla-get-insertionpoint Obj)xsc)))
     (mapcar 'vlax-ename->vla-object
       (vl-remove-if 'listp
         (mapcar 'cadr (ssnamex ss))))))
 (princ))
;;;;;delete;;;;;


;;/delete
(defun delblk (blk / ss)
   (vl-load-com)
     (if (tblsearch "BLOCK" blk)
  (progn
(if (setq ss (ssget "x" (list (cons 0 "INSERT") (cons 2 blk))))
  (mapcar    'vla-delete
   (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
)
	(command "erase" ss "")
)
(command ".purge" "b" blk "n")
)
)
)

Share this post


Link to post
Share on other sites
wrightjd

Hi,

 

I tried the code and it worked perfectly. However, my problem is I have multiple tags with the same name. There are three called NAME in the same block.

 

I need to change only one of these tag's values and was using one of Lee Macs LISP programs to try and change it. But it failed with multiple tags with the same name. I tried this code to change the tag name but it too struggled, changing all three and not just one.

 

Is there a way of homing in on the tag i want to rename? Maybe using co-ords? Or maybe changing one at time till there were no more NAME tags?

 

The goal is to eventually change this one attribute (the engineer's name) on A LOT of drawings.

 

 

Cheers

Share this post


Link to post
Share on other sites
pBe
I tried the code and it worked perfectly. However, my problem is I have multiple tags with the same name. There are three called NAME in the same block.....

The goal is to eventually change this one attribute (the engineer's name) on A LOT of drawings.....

 

And what code is that wrightjd? depending on the code, you can add another set of condtions besides the TAG. Tell me, is the engineer's name the same for every drawing? if not use a list with possible names as elements.

 

 (if  (and (eq TAG NAME)(member  TEXTSRING  '("Name1" "Name2" ...))) (then do this))

Share this post


Link to post
Share on other sites
wrightjd

Cheers for the reply

 

I used the second code posted by hosannabizarre (9th Aug 2010 06:20 pm)

 

Just had a look at the block and there are 3 tags named the same but only one will have the engineer's name I need to change. The name is the same on all drawings and the name it changes to is the same on all drawings.

 

Is there a way I could insert an IF statement to say if the tag name is "NAME" and the value of the tag is "Dennis (BSL)" then change the tag name from "NAME" to "DESIGN ENG"?

 

Really new to programming and just getting lost in the code trying to make changes to suit this problem.

 

Any help is appreciated.

Share this post


Link to post
Share on other sites
pBe
Cheers for the reply

...... say if the tag name is "NAME" and the value of the tag is "Dennis (BSL)" then change the tag name from "NAME" to "DESIGN ENG"?

Any help is appreciated.

 

 

That is strange request, are you wanting to change the TAG only if and only if TAG/TEXSTRING meet the condition?

 

Lets say a block name of "BANANA" has an attribute with tag name "NAME" and the textsting is "Dennis (BSL)", change the TAG to DESIGN_ENG. then there is another "BANNA" block with tag name "NAME" and the textsting is NOT "Dennis (BSL). will the tag name reamains as "NAME"?

 

I believe the you refer to is all good and does exactly waht you want (except for "Dennis (BSL)") , but do you reallize when you insert the block "BANANA" will still have the tag "NAME"? and when someone else work on the drawing file and run attsync it will revert back to its origianl tag?

 

Its that what you want?

 

Demo Code

(defun c:RepEng  (/  Otag Eng NTag BLocks i Attval Found)
(vl-load-com)
(setq Otag  "NAME"
     Eng "DENNIS (BSL)"
     Ntag "DESIGN_ENG")
(if 
(setq Blocks (ssget "_X" '((0 . "INSERT")(66 . 1))))
(repeat (setq i (sslength Blocks))
     (setq AttVal
                (mapcar (function
                              (lambda (at)
                                    (list (vla-get-tagstring at)
                                          (vla-get-textstring at)
                                          at)
                                    ))
                        (vlax-invoke
                              (vlax-ename->vla-object
                                    (ssname Blocks (setq i (1- i))))
                              'Getattributes)
                        )
           )
     (if (setq Found
                    (Car (vl-remove-if-not
                               '(lambda (x)
                                      (and (eq (car x) Otag)
                                           (eq (strcase
                                                     (cadr x))
                                               Eng)))
                               AttVal)))
           (vla-put-tagstring (last Found) Ntag)
           )
     )
)
     (princ)
             )

 

Unless the block with mulitple "NAME" tag and the engineers name will always be on the same order. (e.g 2nd tag of the block), then redefining the block would be a better option IMO.

 

EDIT: I just saw your post on another Forum in which you added this line

 

... change either the tag name or the value to "Daniel" ....

 

in that case. forget everything that i just said and use this

 

[b][color=blue](defun c:RepEng  (/  Otag Eng NTag BLocks i Attval Found)
(vl-load-com)
(setq Otag  "NAME"
     Eng "DENNIS (BSL)"
     NEng "Daniel" )
(if 
(setq Blocks (ssget "_X" '((0 . "INSERT")(66 . 1))))
(repeat (setq i (sslength Blocks))
     (setq AttVal
                (mapcar (function
                              (lambda (at)
                                    (list (vla-get-tagstring at)
                                          (vla-get-textstring at)
                                          at)
                                    ))
                        (vlax-invoke
                              (vlax-ename->vla-object
                                    (ssname Blocks (setq i (1- i))))
                              'Getattributes)
                        )
           )
     (if (setq Found
                    (Car (vl-remove-if-not
                               '(lambda (x)
                                      (and (eq (car x) Otag)
                                           (eq (strcase
                                                     (cadr x))
                                               Eng)))
                               AttVal)))
                  (vla-put-textstring (last Found) NEng)
           )
     )
)
     (princ)
             )[/color][/b]

Edited by pBe

Share this post


Link to post
Share on other sites
wrightjd

Hi thanks for replying again.

 

I think I might have confused you. Or maybe I'm confused.

 

I've attached a picture to try and help.CLIP.jpg

clipmanager.JPG

 

I just need to change the name under DESIGN ENG from what it is to another person's name. This is easily done with other scripts/programs except that the I have duplicate tag names. In this example three tags named "NAME". I need to change the names of the tags so I can use other programs to change the value of the attribute.

 

Does that help?

 

 

Cheers

Share this post


Link to post
Share on other sites
pBe

Did you try the the other code i posted on my previous post [in blue] ?

 

FWIW: on hosannabizarre's code

  (setq namelist (list
     ; list old name and new name. Old name can contain wild cards.
     (list "NAME" "DESIGN_ENG" [color=blue]"Dennis (bsl)" "Daniel")[/color]  ; list old name and new name. 
 ) )

 

 (setq atnam (cdr (assoc 2 edd)) [color=blue]atEng (cdr (assoc 1 edd))[/color][color=black])[/color]

 

 (setq matchname (car x) [color=blue]engname (caddr x)[/color][color=black])[/color]

 

[color=blue](and (eq atnam matchname)[/color][color=blue](eq atEng engname))[/color]

 

(setq newed (subst (cons 1 [color=blue](cadddr x)[/color]) (assoc [color=blue]1[/color] edd) edd))

 

As for changing the target TAG name from "NAME" to DESIGN_ENG" i still stand with redfining the block as i already discuss the flaw with modifying the tags per selected block :)

Share this post


Link to post
Share on other sites
wrightjd

Hi

 

All is good. Drawings updated and looking good.

 

Cheers alot. Saved me tons of time

Share this post


Link to post
Share on other sites
pBe
Hi

 

All is good. Drawings updated and looking good.

 

Cheers alot. Saved me tons of time

 

Good for you. but the blue code will only change the textstring. Tell you what.. give me the name/s of the Blocks with mulitple "NAME" tags. and i'll include a "fix" on the routine to cahnge both the tag and textstring.

Is it always the 3rd "NAME" tag that needs to be change on that specific block? that makes it a lot easier to fix.

 

Share this post


Link to post
Share on other sites
fixo

Hint:

To fix your bad block use commands

Battman

then

Atsync

in the command line

 

~'J'~

Share this post


Link to post
Share on other sites
pBe

You are right Oleg Battman is good and all but if the OP wants to run a script. then..... ;)

Share this post


Link to post
Share on other sites
fixo

Sorry, mate

I told this to wrightjd

My bad,

Regards,

 

Oleg

Share this post


Link to post
Share on other sites
wrightjd

drawing.dwg

Hi guys,

 

Thanks for the interest. Yeah, fixed it but only through a find and replace script changing values followed by a script to batch change the required values. Not the neatest or quickest solution but it worked. Still would be interested to see a better solution but I haven't come up with anything. And I'm sure this problem will arise again.

 

The block is called "A3TITLE" and as far as this drawing set's problem goes it is always the 3rd "NAME" tag that needs to change. I've attached the block in a blank drawing, hope it helps. You can see there are other duplicate tag names as well.

 

Basically now I'm looking to develop a script/code that can change the duplicate tag names. Even if it meant either manually making a list of the old names and new names or simply incrementing the duplicate names numerically. i.e. the final tag names becoming name1 name2 etc. And try and do it for a batch of drawings at once.

 

Cheers again

Share this post


Link to post
Share on other sites
pBe

(defun c:RepEng  (/ _Retag aBlocks Otag Eng NTag BLocks i bnm VerAtt  Found Blklst)
(vl-load-com)
(setq aBlocks (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object))))      
(defun _Retag  (doc bnm ol nw / TagColl)
     (vlax-for
            itm  (vla-item doc bnm)
           (if (and (eq (vla-get-objectname itm)
                        "AcDbAttributeDefinition")
                    (eq (vla-get-tagstring itm) ol))
                 (setq TagColl (append TagColl (list itm)))))
     (cond
           ((not TagColl) nil)
           ((= (length TagColl) 3) (list 2 (last TagColl)))
           ((= (length TagColl) 2) (list 1 (cadr TagColl)))
           ((= (length TagColl) 1) (list 0 (car TagColl)))
           ))      
(setq Otag  "NAME"  Eng "DENNIS (BSL)" NTag "DESIGN_ENG" NEng "DANIEL" )
(if  (setq Blklst nil Blocks (ssget "_X" '((0 . "INSERT")(66 . 1))))
(repeat (setq i (sslength Blocks))
 (if (and (not (assoc (setq bnm (vla-get-effectivename
                 (setq e (vlax-ename->vla-object
                          (ssname Blocks (setq i (1- i)))))))   Blklst))
          (setq VerAtt (_retag aBlocks bnm Otag Ntag)))
          (setq Blklst (cons (list bnm VerAtt)  Blklst)))
      (if (setq Found
                     (vl-remove-if-not
                                '(lambda (x)
                                      (eq (car x) Otag))
                                (mapcar (function
                               (lambda (at)
                                     (list (vla-get-tagstring at)
                                                  (vla-get-textstring at)
                                           at)
                                     ))
                         (vlax-invoke e
                               'Getattributes)
                         )))
                 (progn
                   (vla-put-textstring (last (setq found (nth (caadr  (assoc bnm Blklst)) found))) 
                         (if (eq (cadr found) Eng) NEng (cadr found)))
   (vla-put-tagstring  (last Found) NTAG))
            )
      )
    )
(foreach itm Blklst
      (vla-put-tagstring (cadr (cadr itm)) Ntag)
      (command "_attsync" "_Name" (car itm)))
  (princ)
             )

 

HTH

Edited by pBe
Found yet another bug

Share this post


Link to post
Share on other sites
wrightjd

Works a treat! Thanks. Just wish my LISP understanding was better so I could follow your code.

 

Predicting it's not the last time I'll see this problem so I'm trying to modify the code to direct it to other tag names other then the 3rd "NAME". Where in your code does it focus on the third tag name only? How does it focus on that one?

 

If I wanted to now change the second tag named "NUMBER" I'd change - (setq Otag "NUMBER"........NTAG "Sheetno") but how do I direct it to the second tag? Got lost trying to follow the code

Share this post


Link to post
Share on other sites
pBe

This line

 ((= (length TagColl) 3) (list 2 (last TagColl)))

 

It means if there are three found give me the last item on the list (nth 2 '("1" "2" "3""))->> "3" So if i need to change the 2nd of the three

((= (length TagColl) 3) (list 1 (cadr TagColl))) ... (nth 1 '("1" "2" "3""))->> "2"...

 

Just make sure the 2nd TAG is the "Sheet Nos" on your Block, ibased on the prompt the second TAG is the Drawing Index number. 3rd is Sheet Nos. We may have to re-wirte the code to make it generic.

 

For your other reqeust:

Duplicate Tag Names @ AUGI

Edited by pBe

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...