Jump to content
tmelancon

Edit LISP to rename blocks.. Thanks in advance.

Recommended Posts

tmelancon

First off KUDOS to Tharwat for this brilliant LISP. Can someone edit so its doesnt prompt user for Suffix.. I want the suffix to be -NEW all the time. Also for the block selection I would just like for the lisp to select all everytime. Will be running this on a folder of specific individual blocks. I did in fact try, I just havent succeeded yet thanks.

 

(defun c:RenBlks (/ Blocks *error* cm r ss int sn sfx kw bks nam)
 (vl-load-com)
;;;         Tharwat 31. Oct. 2012             ;;;
;;;   Rename selected or All Blocks as User's inputs    ;;;
 (or acdoc (setq acdoc (vla-get-activedocument (vlax-get-acad-object))))
 (setq Blocks (vla-get-blocks acdoc))
 (setq cm (getvar 'cmdecho))
 (defun *error* (x)
   (if cm
     (setvar 'cmdecho cm)
   )
   (vla-EndUndoMark acdoc)
   (princ "\n")
   (princ "\n *Cancel*:")
 )
 (if (and (not (eq (setq sfx (getstring t "\n Specify Suffix :")) ""))
          (setq r (snvalid sfx))
          (progn (initget "Selected All")
                 (setq kw (cond ((getkword "\n Rename [selected . All] Blocks < Selected > :"))
                                ("Selected")
                          )
                 )
          )
     )
   (if (eq kw "All")
     (progn (vla-StartUndoMark acdoc)
            (vlax-for x Blocks (vl-catch-all-apply 'vla-put-name (list x (strcat (vla-get-name x) sfx))))
            (vla-EndUndoMark acdoc)
     )
     (if (setq ss (ssget "_:L" '((0 . "INSERT"))))
       (progn (vla-StartUndoMark acdoc)
              (setvar 'cmdecho 0)
              (repeat (setq int (sslength ss))
                (setq sn (ssname ss (setq int (1- int))))
                (setq nam (cdr (assoc 2 (entget sn))))
                (if (not (member nam bks))
                  (progn (vl-cmdf "_.-rename" "B" nam (setq nam (strcat nam sfx))) (setq bks (cons nam bks)))
                )
              )
              (vla-EndUndoMark acdoc)
              (setvar 'cmdecho cm)
       )
     )
   )
   (cond ((not sfx) (princ "\n Cancelled by user "))
         ((not r) (princ "\n Not Valid Block name "))
         (t (princ "\n Cancelled by user "))
   )
 )
 (princ "\n Written by Tharwat Al Shoufi")
 (princ)
)

Share this post


Link to post
Share on other sites
Tharwat

Hi,

 

Thank you for the nice words and for using one of my a bit old programs.

 

Is this what you are after?

 

(defun c:renblks  (/ acdoc)
 (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark acdoc)
 (vla-startundomark acdoc)
 (vlax-for x  (vla-get-blocks acdoc)
   (if (and (= (vla-get-islayout x) :vlax-false)
            (= (vla-get-Isxref x) :vlax-false)
            (not (wcmatch (vla-get-name x) "*-NEW"))
            )
     (vl-catch-all-apply
       'vla-put-name
       (list x (strcat (vla-get-name x) "-NEW"))))
   )
 (vla-endundomark acdoc)
 (princ)
 )(vl-load-com)

Share this post


Link to post
Share on other sites
tmelancon

Wow not only are you great, you're fast! Works like I was anticipating! Side note.. would it be a hassle to write a IF statement in there to overlook the block if the block SUFFIX is already NEW... Cheers 4 everything

Share this post


Link to post
Share on other sites
Tharwat
Wow not only are you great, you're fast! Works like I was anticipating!

Thank you.

 

Side note.. would it be a hassle to write a IF statement in there to overlook the block if the block SUFFIX is already NEW... Cheers 4 everything

 

Yes sure, it is already included in the program - so no re-renaming to blocks that already have a suffix of *-NEW.

 

NOTE: At the first post of my first reply I didn't include in the program to exclude Xref & layouts so if you copied the codes before that just recopy the new codes for a better performance.

Share this post


Link to post
Share on other sites
tmelancon

BEAST MODE. Very much obliged.

Share this post


Link to post
Share on other sites
Tharwat
BEAST MODE. Very much obliged.

 

You're welcome.

Share this post


Link to post
Share on other sites
nod684
Hi,

 

Thank you for the nice words and for using one of my a bit old programs.

 

Is this what you are after?

 

(defun c:renblks  (/ acdoc)
 (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark acdoc)
 (vla-startundomark acdoc)
 (vlax-for x  (vla-get-blocks acdoc)
   (if (and (= (vla-get-islayout x) :vlax-false)
            (= (vla-get-Isxref x) :vlax-false)
            (not (wcmatch (vla-get-name x) "*-NEW"))
            )
     (vl-catch-all-apply
       'vla-put-name
       (list x (strcat (vla-get-name x) "-NEW"))))
   )
 (vla-endundomark acdoc)
 (princ)
 )(vl-load-com)

 

 

 

nice one. this will be useful.

thanks

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