Jump to content

rename all blocks adding a letter

maksolino

By maksolino
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

maksolino Contributor

maksolino

Posted
Posted

hello

i am looking for a lisp routine that rename

all, or selected blocks in the drawing

adding a character in the existing name

example

1.select blocks (option all)

2.enter the letter to add

Thanks

gile Collaborator

gile

Posted
Posted

Hi,

 

Something like this ?

 

(defun c:test (/ ss n ent name lst)
 (vl-load-com)
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
       blocks (vla-get-Blocks acdoc)
       )
 (princ "\Select bloc to rename or Enter for all.")
 (if (or (ssget '((0 . "INSERT")))  (ssget "_X" '((0 . "INSERT"))))
   (if (setq pref (getstring "\nEnter the prefix to add: "))
     (progn
       (vlax-for b (setq ss (vla-get-ActiveSelectionSet acdoc))
         (setq name (vla-get-name b))
         (if (not (vl-position name lst))
           (setq lst (cons name lst))
           )
         )
       (foreach n lst
         (vla-put-Name (vla-item blocks n) (strcat pref n))
       )
     )
   )
 )
 (princ)
)

  • Like 1
maksolino Contributor

maksolino

Posted
  • Author
Posted

Thanks gile , that's OK

but that lisp not resolve my problem becouse my blocks are

built whit many others blocks in few level.

Please can you expande your lisp to rename also

the block inside (i really mean all existing blocks).

Have a nice day

David Bethel Grand Master

David Bethel

Posted
Posted
Thanks gile , that's OK

but that lisp not resolve my problem becouse my blocks are

built whit many others blocks in few level.

Please can you expande your lisp to rename also

the block inside (i really mean all existing blocks).

Have a nice day

 

 

Your basic request is pretty easy using RENAME. The problem lies in the renaming of blocks that already exist.

 

Let's say that you already have BLOCKS DOOR1 and DOOR1A and that you want to add the letter A as a suffix. When you go to rename DOOR1 to DOOR1A, do you overwrite the existing block definition?, skip it? or try itinerating all the way through the block table and keep track of it. That could be intense. -David

gile Collaborator

gile

Posted
Posted

This on should work with nested blocks too

 

(defun c:test (/ getNestedNames remove_duplicates ss n ent name lst)
 (vl-load-com)
 (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))))
 (or *blocks* (setq *blocks* (vla-get-Blocks *acdoc*)))

 ;; Returns a list of the nested block names
 (defun getNestedNames (name / lst)
   (vlax-for o (vla-Item *blocks* name)
     (if (= (vla-get-ObjectName o) "AcDbBlockReference")
       (setq lst (append (list (vla-get-Name o))
                         (getNestedNames (vla-get-Name o))
                         lst
                 )
       )
     )
   )
   lst
 )

 ;; Removes all duplicates from a list
 (defun remove_duplicates (lst)
   (if lst
     (cons (car lst) (remove_duplicates (vl-remove (car lst) lst)))
   )
 )

 ;; Main
 (if (setq pref (getstring "\nEnter the prefix to add: "))
   (progn
     (vla-StartUndoMark *acdoc*)
     (princ "\Select bloc to rename (or Enter for all)")
     (if (ssget '((0 . "INSERT")))
       ;; selection
       (progn
         (vlax-for b (setq ss (vla-get-ActiveSelectionSet *acdoc*))
           (setq name (vla-get-name b))
           (if (not (vl-position name lst))
             (setq lst (append (list name) (getNestedNames name) lst))
           )
         )
         (vla-delete ss)
         (foreach n (remove_duplicates lst)
           (vla-put-Name (vla-item *blocks* n) (strcat pref n))
         )
       )
       ;; all
       (vlax-for b *blocks*
         (if (and
               (= (vla-get-IsLayout b) :vlax-false)
               (= (vla-get-IsXref b) :vlax-false)
               (not (wcmatch (setq name (vla-get-Name b)) "*|*"))
             )
           (vla-put-Name b (strcat pref name))
         )
       )
     )
     (vla-EndUndoMark *acdoc*)
   )
 )
 (princ)
)

maksolino Contributor

maksolino

Posted
  • Author
Posted

Thanks guys

that is exactly what i was looking for

David Bethel Grand Master

David Bethel

Posted
Posted

Or another approach could be:

[b][color=BLACK]([/color][/b]defun c:addbs [b][color=FUCHSIA]([/color][/b]/ adds str bn nn ext[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]initget 1 [color=#2f4f4f]"Suffix Prefix"[/color][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq adds [b][color=NAVY]([/color][/b]getkword [color=#2f4f4f]"\nAdd String As - Suffix/Prefix:   "[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]or [b][color=MAROON]([/color][/b]not str[b][color=MAROON])[/color][/b]
            [b][color=MAROON]([/color][/b]not [b][color=GREEN]([/color][/b]snvalid str[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq str [b][color=MAROON]([/color][/b]getstring [color=#2f4f4f]"\nBlock Name String To Add:   "[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]setq tdef [b][color=MAROON]([/color][/b]tblnext [color=#2f4f4f]"BLOCK"[/color] [b][color=GREEN]([/color][/b]not tdef[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq bn [b][color=MAROON]([/color][/b]cdr [b][color=GREEN]([/color][/b]assoc 2 tdef[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq nn [b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]= adds [color=#2f4f4f]"Prefix"[/color][b][color=GREEN])[/color][/b]
                     [b][color=GREEN]([/color][/b]strcat str bn[b][color=GREEN])[/color][/b]
                     [b][color=GREEN]([/color][/b]strcat bn str[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]cond [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]= [color=#2f4f4f]"*"[/color] [b][color=BLUE]([/color][/b]substr bn 1 1[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
              [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]not [b][color=BLUE]([/color][/b]tblsearch [color=#2f4f4f]"BLOCK"[/color] nn[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
               [b][color=GREEN]([/color][/b]command [color=#2f4f4f]"_.RENAME"[/color] [color=#2f4f4f]"_Block"[/color] bn nn[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
              [b][color=MAROON]([/color][/b]T [b][color=GREEN]([/color][/b]setq ext [b][color=BLUE]([/color][/b]cons bn ext[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]if ext [b][color=NAVY]([/color][/b]alert [color=#2f4f4f]"All Blocks Could Not Be RENAMEd"[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1 ext[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

 

-David

  • 5 months later...
Astro Explorer

Astro

Posted
Posted
Hi,

 

Something like this ?

 

(defun c:test (/ ss n ent name lst)
 (vl-load-com)
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
       blocks (vla-get-Blocks acdoc)
       )
 (princ "\Select bloc to rename or Enter for all.")
 (if (or (ssget '((0 . "INSERT")))  (ssget "_X" '((0 . "INSERT"))))
   (if (setq pref (getstring "\nEnter the prefix to add: "))
     (progn
       (vlax-for b (setq ss (vla-get-ActiveSelectionSet acdoc))
         (setq name (vla-get-name b))
         (if (not (vl-position name lst))
           (setq lst (cons name lst))
           )
         )
       (foreach n lst
         (vla-put-Name (vla-item blocks n) (strcat pref n))
       )
     )
   )
 )
 (princ)
)

 

 

Hi all,

 

this routine is working well, but is it possible to add also dynamic blocks to it? I need to add a prefix to about 1000 blocks...

 

maybe this post can help

 

http://www.cadtutor.net/forum/showthread.php?t=40921

 

thank you in advance!

 

Just found what i was looking for ;)

 

http://www.cadtutor.net/forum/showthread.php?t=43215

  • 12 years later...
Thiyagu Newbie

Thiyagu

Posted
Posted
On 11/4/2009 at 9:04 PM, gile said:

This on should work with nested blocks too

 

  

(defun c:test (/ getNestedNames remove_duplicates ss n ent name lst)
 (vl-load-com)
 (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))))
 (or *blocks* (setq *blocks* (vla-get-Blocks *acdoc*)))

 ;; Returns a list of the nested block names
 (defun getNestedNames (name / lst)
   (vlax-for o (vla-Item *blocks* name)
     (if (= (vla-get-ObjectName o) "AcDbBlockReference")
       (setq lst (append (list (vla-get-Name o))
                         (getNestedNames (vla-get-Name o))
                         lst
                 )
       )
     )
   )
   lst
 )

 ;; Removes all duplicates from a list
 (defun remove_duplicates (lst)
   (if lst
     (cons (car lst) (remove_duplicates (vl-remove (car lst) lst)))
   )
 )

 ;; Main
 (if (setq pref (getstring "\nEnter the prefix to add: "))
   (progn
     (vla-StartUndoMark *acdoc*)
     (princ "\Select bloc to rename (or Enter for all)")
     (if (ssget '((0 . "INSERT")))
       ;; selection
       (progn
         (vlax-for b (setq ss (vla-get-ActiveSelectionSet *acdoc*))
           (setq name (vla-get-name b))
           (if (not (vl-position name lst))
             (setq lst (append (list name) (getNestedNames name) lst))
           )
         )
         (vla-delete ss)
         (foreach n (remove_duplicates lst)
           (vla-put-Name (vla-item *blocks* n) (strcat pref n))
         )
       )
       ;; all
       (vlax-for b *blocks*
         (if (and
               (= (vla-get-IsLayout b) :vlax-false)
               (= (vla-get-IsXref b) :vlax-false)
               (not (wcmatch (setq name (vla-get-Name b)) "*|*"))
             )
           (vla-put-Name b (strcat pref name))
         )
       )
     )
     (vla-EndUndoMark *acdoc*)
   )
 )
 (princ)
)
 

 

I was trying to write variables and codes for the same but doesn't work.  But this code helps me a lot. in terms of revision. I had to go forth and back to edit manually one by one. Now it looks pretty easy  to handle number of blocks. Thank you very much Gile

Thiyagu Newbie

Thiyagu

Posted
Posted
On 11/4/2009 at 4:16 PM, maksolino said:

hello

i am looking for a lisp routine that rename

all, or selected blocks in the drawing

adding a character in the existing name

example

1.select blocks (option all)

2.enter the letter to add

Thanks

Thank you Maksolino for your post.

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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  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.

×
 Share
Go to topic listing
×
×
  • Create New...