tmelancon Posted May 5, 2016 Posted May 5, 2016 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) ) Quote
Tharwat Posted May 5, 2016 Posted May 5, 2016 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) Quote
tmelancon Posted May 5, 2016 Author Posted May 5, 2016 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 Quote
Tharwat Posted May 5, 2016 Posted May 5, 2016 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. Quote
nod684 Posted May 6, 2016 Posted May 6, 2016 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 Quote
Recommended Posts
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.