Command: RENAMEBLOCK
This function renames selected block or xref. Program asks for a new name in dialog window. In dialog window program pastes old name in case the user wants f.e. to set a simillar name but with different sufix or prefix.
Command: RENAMELAYER
As above but renames layer of selected object.
Code:
;;; =================================================
;;; RENAME_BLOCK_LAYER+DCL_v3_01.LSP
;;;
;;; Written by Andrzej Kalinowski, www.autolisps.blogspot.com
;;; v2.00 - 18.02.2016
;;; v2.01 - 11.11.2020 - fixed bug in RENAMEBLOCK command - adjusted to work with non english autocad versions
;;; v2.02 - 30.04.2022 - corrected quiting the "Objects selection" loop, dialogbox size made dependant from the length of the layer, added "check for updates "button
;;; v3.00 - 20.05.2022 - added renaming anonymous blocks
;;; v3.01 - 09.07.2022 - misc improvements in code
;;;
;;; Command: RENAMEBLOCK - renames selected block or xref (INSERT)
;;; Command: RENAMELAYER - renames layer of selected object
;;; =================================================
(defun c:RENAMEBLOCK () (RB_RL_COMMON 1) )
(defun c:RENAMELAYER () (RB_RL_COMMON 2) )
(vl-load-com)
(defun RB_RL_COMMON (mode1 / obj1 Name01 Name02 uInput IfCrrct1 gr1 bl1)
(setq Name02 nil)
;-----------------------------------------
;object selection
;-----------------------------------------
(setq obj1 nil gr1 1)
(prompt "\nSelect an object ")
(while (/= gr1 52)
(setvar "ERRNO" 0);reset ERRNO to 0
(setq obj1 (ssget "_+.:S") )
(setq gr1 (getvar "ERRNO") )
(if (= (getvar "ERRNO") 52) (exit))
(if (= obj1 nil)
(princ "\nWrong object");then
(if (> (sslength obj1) 1);else-checks if only 1 obj is selected
(progn ;
(princ "\nSelect only one object: ")(princ)
(setq obj1 nil)
);progn
(progn ;else
(setq obj1 (ssname obj1 0) );takes first and only one element from selset1. You can retreive entlist from element of seleset - not from selset.
(if (= mode1 1)
(if (/= (cdr (assoc 0 (entget obj1)) ) "INSERT")
(progn (prompt "\nWrong object") (setq obj1 nil ) )
(progn
(setq gr1 52 )
(if (or (vl-string-search "*" (cdr (assoc 2 (entget obj1) ) ) ) ( /= (vla-get-effectivename (vlax-ename->vla-object obj1)) (cdr (assoc 2 (entget obj1) ) ) ) )
(setq Name02 (vla-get-effectivename (vlax-ename->vla-object obj1))
;Name01 (strcat (vla-get-effectivename (vlax-ename->vla-object obj1)) " <" (cdr (assoc 2 (entget obj1) ) ) ">") ; ;".anonymous: "
Name01 (cdr (assoc 2 (entget obj1) ) ) ; ;".anonymous: "
);setq
(setq Name01 (cdr (assoc 2 (entget obj1) ) ) );setq
);if
);if
); if
(setq gr1 52 Name01 (cdr (assoc 8 (entget obj1)) ) )
);if
);progn else
);if
); if
); while
;-----------------------------------------
;getting new name
;-----------------------------------------
(setq uInput (RB_RL_SETNEWNAME_DCL mode1 Name01 Name02 0) )
(setq IfCrrct1 (RB_RL_NAMECHECK uInput ) );RB_RL_SETNEWNAME_DCL function opens DCL window i writes old name in the active field in case you want to change only part of it
(while
(or
(= uInput nil)
(= uInput "")
(= IfCrrct1 0);checks if in uInput there are other signs then " "
(= IfCrrct1 -1);not allowed charaxcters
(and (/= uInput Name01) (/= (tblsearch (if (= mode1 1) "Block" "Layer") uInput) nil ) )
);or
(cond
( (or (= IfCrrct1 0) (= nil uInput) (= "" uInput) )
(setq uInput (RB_RL_SETNEWNAME_DCL mode1 Name01 Name02 0) )
(setq IfCrrct1 (RB_RL_NAMECHECK uInput ) )
)
( (= IfCrrct1 -1)
(setq uInput (RB_RL_SETNEWNAME_DCL mode1 Name01 Name02 -1) )
(setq IfCrrct1 (RB_RL_NAMECHECK uInput ) )
)
( (/= (tblsearch (if (= mode1 1) "Block" "Layer") uInput) nil )
(setq uInput (RB_RL_SETNEWNAME_DCL mode1 Name01 Name02 1) )
(setq IfCrrct1 (RB_RL_NAMECHECK uInput ) )
)
);cond
);while
;-----------------------------------------
(if (/= uInput Name01)
(progn
(if (= mode1 1)
(vlax-for bl1 (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
(if (= (vla-get-name bl1) Name01) (vla-put-name bl1 uInput) )
)
(command "_-rename" "_Layer" Name01 uInput);renaming
);if
(if (= mode1 1)
(progn
(if (vlax-property-available-p (vlax-ename->vla-object obj1) "Path") (command "-xref" "_reload" uInput) );reloading selected xref to update name in xref manager
(princ "\n\Name changed from: ") (princ Name01) (princ "\tto: ") (princ uInput)
);progn
(progn (princ "\n\Name changed from: ") (princ Name01) (princ "\tto: ") (princ uInput) )
);if
);progn
);if
;----------------------------------------
(princ);exiting quietly
);defun RB_RL_COMMON
;;; ================================================
; RB_RL_NAMECHECK
;;; ================================================
(defun RB_RL_NAMECHECK ( NameToCheck1 / i1 result2 chrLst elmLst rtrn1)
;-----------------------------------------
;checks if new name is made only froms spaces
;-----------------------------------------
(setq result2 0 )
(setq i1 1 )
(repeat (strlen NameToCheck1)
(if (/= (substr NameToCheck1 i1 1) " ") (setq result2 (+ result2 1) ) )
(setq i1 (+ i1 1) )
);repeat
;-----------------------------------------
;checks not allowed charakters
;-----------------------------------------
(if (/= result2 0)
(progn
(setq chrLst (list "\\" "<" ">" "/" "?" "\"" ":" ";" "*" "|" "," "=") )
(if (> (strlen NameToCheck1) 0)
(foreach elmLst chrLst (if (vl-string-search elmLst NameToCheck1) (setq rtrn1 -1) ) )
(setq rtrn1 -1)
);if
);progn
);if
;-----------------------------------------
(cond
( (= result2 0) (setq result2 0) )
( (= rtrn1 -1) (setq result2 -1) )
( T (setq result2 1))
);cond
result2
);defin
;;; ================================================
; DCL SECTION
;;; ================================================
(defun RB_RL_SETNEWNAME_DCL (mode1 currentname1 currentname2 errVal / tmpfpath1 infile1 dcl_id result1 oldName01 DBwid dclexit3 tmp1 Tx1 Tx2 Tx3 Tx4 Tx5)
(if currentname2
(setq
Tx1 (strcat "Note: You have selected a dynamic block - a wariation of a block named \"" currentname2 "\"" )
Tx2 "You can change only the old name and the new name will be visible in the block collection."
Tx3 "The effective name cannot be changed and it will still be visible in the properties."
Tx4 "By any modification to your newly named dynamic block Autocad will create"
Tx5 (strcat "a new anonymous block \"*U...\" with an effective name \"" currentname2 "\"")
);setq
);if
;-----------------------------------------
;defining width of the edit_box filed
;-----------------------------------------
(if currentname2
(if (> (strlen currentname1) (strlen currentname2)) (setq tmp1 currentname1 ) (setq tmp1 currentname2 ) )
(setq tmp1 currentname1)
);if
(setq DBwid 40 );here we set minimal width of our Dialog Box
(if (> (strlen tmp1) DBwid) (setq DBwid (fix (* 1.2 (strlen tmp1) ) ) ))
(if Tx1 (if (> (strlen Tx1) DBwid) (setq DBwid (fix (* 1.2 (strlen Tx1) ) ) )) )
(setq DBwid (itoa DBwid) )
;-----------------------------------------
(setq tmpfpath1 (strcat (getvar "MYDOCUMENTSPREFIX") "\\TEMP1DCL.DCL") )
(setq infile1 (open tmpfpath1 "w") )
(write-line
(strcat
"dialog1 : dialog
{ label = \"RENAME " (if (= mode1 1) "BLOCK" "LAYER" ) " 3.01\";"
(if currentname2 "
: text { key = \"DynamicB_key1\"; }
: text { key = \"DynamicB_key2\"; }
: text { key = \"DynamicB_key3\"; }
: text { key = \"DynamicB_key4\"; }
: text { key = \"DynamicB_key5\"; }
: text { label = \"\"; }"
"" ) "
: text { key = \"old_name_field1\"; } "
(if currentname2 "
: text { key = \"old_name_field2\"; } " "" ) "
: edit_box
{
label = \"New name:\";
key = \"field1\";
width = " DBwid " ;
allow_accept = true;
}
: errtile {}
: row
{
: button { key = updates_key; label = \"Check for updates\"; width = 2 ;fixed_width = true;}
ok_cancel;
}
: text {label =\"autolisps.blogspot.com\";}
}"
);strcat
infile1
);write line
(close infile1)
(setq dcl_id (load_dialog tmpfpath1) )
(if (new_dialog "dialog1" dcl_id)
(progn
(set_tile "old_name_field1" (strcat (if currentname2 "Old name:\t\t" "Old name: ") currentname1) )
(if currentname2
(progn
(set_tile "old_name_field2" (strcat "Effective name:\t\t" currentname2) )
(set_tile "DynamicB_key1" Tx1)
(set_tile "DynamicB_key2" Tx2)
(set_tile "DynamicB_key3" Tx3)
(set_tile "DynamicB_key4" Tx4)
(set_tile "DynamicB_key5" Tx5)
);progn
);if
(if (= errVal 1) (set_tile "error" "Error: The name you entered already exists in the drawing.") )
(if (= errVal -1) (set_tile "error" "Error: The following characters are not allowed: <>/|\?,=:;*"))
(set_tile "field1" currentname1 )
(mode_tile "field1" 2);makes the field named "field1" active and lets you to start typing immediately
(action_tile "updates_key" "(startapp \"explorer\" \"http://autolisps.blogspot.com/p/renameblockorlayerdcl.html\")")
(action_tile "accept" "(setq result1 (get_tile \"field1\")) (done_dialog)")
(action_tile "cancel" "(setq result1 currentname1) (done_dialog) (vl-file-delete tmpfpath1 ) (setq dclexit3 1)")
(start_dialog)
(unload_dialog dcl_id)
(vl-file-delete tmpfpath1 )
);progn
(exit);else
);if
(if (= dclexit3 1) (exit) result1 )
);defun
Example (with short command aliases):
File format:
.FAS
Version history:
1.00 - 18.02.2016 - First release.
2.00 - 18.02.2016
2.01 - 11.11.2020 - fixed bug in RENAMEBLOCK command - adjusted to work with non english autocad versions
2.02 - 30.04.2022 - corrected quiting the "Objects selection" loop, dialogbox size made dependant from the length of the layer, added "check for updates "button
3.00 - 20.05.2022 - added renaming anonymous blocks
3.01 - 09.07.2022 - misc improvements in code
Compatibility:
-All Autocad versions
Remarks:
-The application comes with the long command names listed above. To create your own short aliases for these commands, go to ACAD.PGP file or Menu Manage->Customization->Edit aliases->Edit Aliases. Command aliases used in video-example: RB for RENAMEBLOCK, RL for RENAMELAYER
Download:
RENAME_BLOCK_LAYER+DCL_v3_01.FAS
i not use autocad version 2023, your update thank you
ReplyDeleteI can't use renamelayer function, please help me to fix it. Thanks
ReplyDeleteHello, please provide more info. Do you get eny error?
DeleteCan you update it for Autocad 2024, thanks
ReplyDelete