Jump to content

Layer Rename Lisp Routine Issue


CAD_Question

Recommended Posts

 

Hi Everyone,

 

I have been using this lisp routine that allows me to remove or rename layers, which is very useful. One issue I'm running into is that once its loaded through appload it automatically launches the routine with out the shortcut key being input. Once the lisp path is set to auto load when opening AutoCAD it will cause the lisp to run as the drawing loads and due to the settings it will prevent you from opening the drawing due to a constant cycle of "no matching text found. try again." and the initial dialog box (it might be easier to see what i mean by loading this and trying for yourself). If anyone could edit this so that the program only initializes when the shortcut keys are input (LRN) followed by the enter key it would be greatly appreciated. Thanks. 

 

 

(vl-load-com)
(defun LRN_dialog ()
(setq fname (vl-filename-mktemp "LayerRename.dcl"))
(if (setq fn (open fname "w"))
(foreach str
'("LayerRename : dialog { label = \"Layer Rename (Case Sensitive)\";"
":boxed_column { label = \"Rename Layers Containing\";"
":edit_box { label = \"String :\"; key = \"SearchBox\"; alignment = centered; edit_limit = 35; edit_width = 30; }}"
":boxed_column { label = \"Add\";"
":edit_box { label = \"Prefix :\"; key = \"NPFX\"; alignment = centered; edit_limit = 35; edit_width = 30; }"
":edit_box { label = \"Suffix :\"; key = \"NSFX\"; alignment = centered; edit_limit = 35; edit_width = 30; }}"
":boxed_column { label = \"Remove\";"
":edit_box { label = \"String:\"; key = \"RMV\"; alignment = centered; edit_limit = 35; edit_width = 30; }"
":toggle { key = \"merge\"; label = \"Auto Merge Layers after 'Remove'\";}}"
":boxed_column { label = \"Replace\";"
":edit_box { label = \"Replace :\"; key = \"OSTR\"; alignment = centered; edit_limit = 35; edit_width = 30; }"
":edit_box { label = \"With :\"; key = \"NSTR\"; alignment = centered; edit_limit = 35; edit_width = 30; }}"
":boxed_column { label = \"Additional\";"
":column {"
":toggle { key = \"case\"; label = \"Apply All Caps\";}}}"
":row {"
":button { key = \"accept\"; label = \"OK\"; is_default = true; edit_width = 20; alignment = centered;}"
":button { key = \"cancel\"; label = \"Cancel\"; edit_width = 20; alignment = centered; is_cancel = true;}}"
":errtile { width = 34; } }")
(write-line str fn)))
(close fn)
);defun

(defun C:lrn ( / temperr ActDoc oldecho dcl_id fn fname nsfx npfx layerlist
n mlst x sb userclick rmv rpfx rsfx obj layer ostr nstr nlayer case merge layerlist)
(defun *error* (msg)
(cond
((not msg))
((wcmatch (strcase msg) "*QUIT*,*CANCEL*"))
(T (princ (strcat "\nError: " msg)))
)
(setq *error* temperr)
(acet-ui-progress)
(if (= (getvar "cmdactive") 0)(acet-ui-progress))
(vl-file-delete fname)
(setvar 'cmdecho oldecho)
(princ)
);defun

(setq temperr *error* ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-EndUndoMark ActDoc)
(vla-StartUndoMark ActDoc)
(setq oldecho (getvar 'cmdecho))
(setvar 'cmdecho 0)
(LRN_dialog)
(setq dcl_id (load_dialog fname))
(if (not (new_dialog "LayerRename" dcl_id))(exit))
(setq case 0 merge 0)
(mode_tile "SearchBox" 2)
(mapcar '(lambda (lvar) (mode_tile lvar 0))'("NPFX" "NSFX" "RPFX" "RSFX" "RMV" "OSTR" "NSTR" "case" "merge"))
(action_tile "SearchBox" "(setq SB $value)")
(action_tile "NPFX" "(setq NPFX $value)")
(action_tile "NSFX" "(setq NSFX $value)")
(action_tile "RMV" "(setq RMV $value)")
(action_tile "OSTR" "(setq OSTR $value)")
(action_tile "NSTR" "(setq NSTR $value)")
(action_tile "case" "(setq case (atoi $value))")
(action_tile "merge" "(setq merge (atoi $value))")
(action_tile "accept" "(done_dialog) (setq userclick T)")
(action_tile "cancel" "(done_dialog) (setq userclick nil)")

(start_dialog)
(unload_dialog dcl_id)

(and (or (not (member nstr '("" NIL)))(not (member ostr '("" NIL))))
(or (member nstr '("" NIL))(member ostr '("" NIL)))
(not (alert "Missing info in replace fields. Try again."))(c:lrn))

(setq mlst (reverse (ai_table "layer" 4)) n 0);setq

(foreach x mlst
(and (member SB '("" NIL))(/= x "0")(not (vl-position x layerlist))(setq layerlist (cons x layerlist)))
(and (not (member SB '("" NIL)))(/= x "0")(vl-string-search SB x)(not (vl-position x layerlist))(setq layerlist (cons x layerlist)))
);foreach

(acet-ui-progress "Modifying Layers:" (length layerlist))

(if (not layerlist)(progn (acet-ui-progress)(Alert "No Matching Text Found. Try Again.")(c:lrn)))

(repeat (length layerlist)
(setq nlayer (nth n layerlist))
(and (not (member RMV '("" NIL)))(setq nlayer (vl-string-subst "" RMV nlayer)))
(and (not (member ostr '("" NIL)))(not (member nstr '("" NIL)))(setq nlayer (acet-str-replace ostr nstr nlayer)))
(and (not (member npfx '("" NIL)))(setq nlayer (strcat npfx nlayer)))
(and (not (member nsfx '("" NIL)))(setq nlayer (strcat nlayer nsfx)))
(and (= merge 1)(/= nlayer (nth n layerlist))(vl-position nlayer mlst)(vl-cmdf "-laymrg" "n" (nth n layerlist) "" "n" nlayer "y")
(= case 1)(vl-cmdf "-rename" "la" nlayer (strcase nlayer)))
(and (or (= (nth n layerlist) nlayer) (not (vl-position nlayer mlst)))(vl-cmdf "-rename" "la" (nth n layerlist) (if (zerop case) nlayer (strcase nlayer))))
(setq n (1+ n))
(acet-ui-progress -1)
);repeat

(acet-ui-progress)
(setq *error* temperr)
(setvar 'cmdecho oldecho)
(vl-file-delete fname)
(vla-EndUndoMark ActDoc)
(princ)
);defun

(c:lrn)

Link to comment
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
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.

×
×
  • Create New...