;;; Rename selected blocks (add prefix) Written by Tharwat Al Shoufi

(defun c:RSB (/ 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 Prefix :")) ""))
(setq r (snvalid sfx))
(progn (initget "Selected All")
(setq kw (cond ((getkword "\n Rename [Selected . All] Blocks :"))
("Selected")
)
)
)
)
(if (eq kw "All")
(progn (vla-StartUndoMark acdoc)
(vlax-for x Blocks (vl-catch-all-apply 'vla-put-name (list x (strcat sfx (vla-get-name x)))))
(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 sfx nam))) (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)
)
(c:rsb)

Advertisements