Changing layer by typing the layer name

[gerbaux]

(defun c:LAYER1 (/ ss) (SetLayerCurrent "LAYER1") (and (setq ss (ssget "_I")) (ChangeLayer ss "LAYER1")) (princ))

 

sir, after running the makelayerlisp command, i open the layerlisp.lsp, the found this.. only 1 layer is created.. am i doing it correctly? thankz in advance...

[fbby]

what is the difference of Cad64 and gerbaux lisp?

[gerbaux]

what is the difference of Cad64 and gerbaux lisp?

 

fyi.. hehehe... i dont have an lisp... Cad64 and CAB i just helping me out.. the LISP that i quoted is the result of the MAKElayerLISP command that CAB coded for me...:wink: have you tried it?

[gerbaux]

sir, after running the makelayerlisp command, i open the layerlisp.lsp, the found this.. only 1 layer is created.. am i doing it correctly? thankz in advance...

 

 

nyahahahaha! i' know what's the problem, as i study carefully the lsp of CAB, i saw that it's only doing the names with the format 1letter and 2 numbers(?##).. sorry!!!! now i understand...

[fbby]

No sir Im not yet, Im only tried Cad64 and your lsp, Im wondering if there any differences on both lsp, btw, no need to sorry sir Im just asking

 

 

 

 

_________________________

sorry for my english

[CAB]

I changed the code above to make the Layer name Filter more obvious to the user.

Added this:

  ;;  -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
 ;;  This is the Filter for Layer names
 ;;  Set to <One String> & <Two Number Characters>
 (setq LayFilter "?##")  ; See the HELP file on wcmatch
 ;;  -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-

[alanjt]

will not work for layers with the same names as standart acad commands (line, circle, move etc.)

(vl-load-com)
(defun LayerCommand (reactor_object obj)
 (if (vl-some (function (lambda (r) (= (vlr-data r) "LayerCommand")))
          (cdar (vlr-reactors :VLR-Command-Reactor))
     )
   (if    (and (car obj)
        (setq obj (tblobjname "LAYER" (car obj)))
        (setq obj (vlax-ename->vla-object obj))
   )
     (progn (vla-put-Freeze obj :vlax-false)
        (vla-put-ActiveLayer
          (vla-get-ActiveDocument (vlax-get-acad-object))
          obj
        )
     )
   )
   (vlr-command-reactor
     "LayerCommand"
     (list (cons :vlr-unknownCommand 'LayerCommand))
   )
 )
)
;;;(LayerCommand nil nil) ;run this once per session
;;;(vlr-remove-all :VLR-Command-Reactor) ;run this to remove the reaction

 

 

 

incredible is too cheap of a word to describe this.

[ASMI]

Other decision with very short programs of call of layers on the basis on reactors. It it is necessary to load and call layers by the commands LA1, LA2 or LA3.

 

 

;;;***************************************************************************
;;;                        THIS IS LAYER CALLS
;;;***************************************************************************

(defun c:la1()(§cf))
(defun c:la2()(§cf))
(defun c:la3()(§cf))

;;;***************************************************************************
;;;                        END OF LAYER CALLS
;;;***************************************************************************

(vl-load-com)

(defun Autokey_Layer()
 (if(not key_layer:reactor)
   (setq key_layer:reactor
   (vlr-Lisp-Reactor nil
     '((:vlr-lispWillStart . Cath_Lisp_Name)
       (:vlr-lispEnded . Change_or_Create_Layer))))
   ); end if
 (princ)
 ); end of Autokey_Layer

(defun Cath_Lisp_Name(Reac Args)
 (setq key_layer:layname(car Args))
 (princ)
 ); end of Cath_Lisp_Name

(defun Change_or_Create_Layer(Reac Args / layName)
 (if layname:Flag
   (progn
     (setq layname:Flag nil
    layName(substr
	     (substr key_layer:layname 4) 1
	     (-(strlen key_layer:layname) 4))
    ); end setq
     (if(not(tblsearch "LAYER" layName))
(vla-add(vla-get-Layers
	  (vla-get-ActiveDocument
	    (vlax-get-acad-object))) layName)
); end if
     (setvar "CLAYER" layName)
     ); end progn
   ); end if
 (princ)
 ); end of Change_or_Create_Layer

(defun §cf()
 (setq layname:Flag T)
 (princ)
 ); end of §cf

(Autokey_Layer)

[lisplost]

CAB I really like the Code that you made for changing to existing layers. We modified it to accept all of the standard layers that we use by replacing the "?##" with "*". Now in addition to this we want it to create a new layer simply by typing the layer name. It will recognize the layer from the layerLisp file it created and that is where we wanted the command to create the new, without having to walk through all the standard steps with a "-layer" command. We want it to create a simple layer that we will later change according to our standards. Is there anyway to update this code to incorporate this?

 

This is what we currently have in our LayerLISP file

 

 
(defun c:0 (/ ss) (SetLayerCurrent "0") (and (setq ss (ssget "_I")) (ChangeLayer ss "0")) (princ))
(defun c:BACKGROUND (/ ss) (SetLayerCurrent "BACKGROUND") (and (setq ss (ssget "_I")) (ChangeLayer ss "BACKGROUND")) (princ))
(defun c:BORDER (/ ss) (SetLayerCurrent "BORDER") (and (setq ss (ssget "_I")) (ChangeLayer ss "BORDER")) (princ))
(defun c:CONTROL (/ ss) (SetLayerCurrent "CONTROL") (and (setq ss (ssget "_I")) (ChangeLayer ss "CONTROL")) (princ))
(defun c:DASHED (/ ss) (SetLayerCurrent "DASHED") (and (setq ss (ssget "_I")) (ChangeLayer ss "DASHED")) (princ))
(defun c:DEFPOINTS (/ ss) (SetLayerCurrent "DEFPOINTS") (and (setq ss (ssget "_I")) (ChangeLayer ss "DEFPOINTS")) (princ))
(defun c:DETAIL (/ ss) (SetLayerCurrent "DETAIL") (and (setq ss (ssget "_I")) (ChangeLayer ss "DETAIL")) (princ))
(defun c:DIMENSION (/ ss) (SetLayerCurrent "DIMENSION") (and (setq ss (ssget "_I")) (ChangeLayer ss "DIMENSION")) (princ))
(defun c:ENCLOSURE (/ ss) (SetLayerCurrent "ENCLOSURE") (and (setq ss (ssget "_I")) (ChangeLayer ss "ENCLOSURE")) (princ))
(defun c:EXISTING (/ ss) (SetLayerCurrent "EXISTING") (and (setq ss (ssget "_I")) (ChangeLayer ss "EXISTING")) (princ))
(defun c:GROUND (/ ss) (SetLayerCurrent "GROUND") (and (setq ss (ssget "_I")) (ChangeLayer ss "GROUND")) (princ))
(defun c:HATCH (/ ss) (SetLayerCurrent "HATCH") (and (setq ss (ssget "_I")) (ChangeLayer ss "HATCH")) (princ))
(defun c:LIGHTING (/ ss) (SetLayerCurrent "LIGHTING") (and (setq ss (ssget "_I")) (ChangeLayer ss "LIGHTING")) (princ))
(defun c:MATCHLINE (/ ss) (SetLayerCurrent "MATCHLINE") (and (setq ss (ssget "_I")) (ChangeLayer ss "MATCHLINE")) (princ))
(defun c:POWER (/ ss) (SetLayerCurrent "POWER") (and (setq ss (ssget "_I")) (ChangeLayer ss "POWER")) (princ))
(defun c:POWERF (/ ss) (SetLayerCurrent "POWER FUTURE") (and (setq ss (ssget "_I")) (ChangeLayer ss "POWER FUTURE")) (princ))
(defun c:RECEPTACLES (/ ss) (SetLayerCurrent "RECEPTACLES") (and (setq ss (ssget "_I")) (ChangeLayer ss "RECEPTACLES")) (princ))
(defun c:RED-NOTE (/ ss) (SetLayerCurrent "RED-NOTE") (and (setq ss (ssget "_I")) (ChangeLayer ss "RED-NOTE")) (princ))
(defun c:REV (/ ss) (SetLayerCurrent "REV") (and (setq ss (ssget "_I")) (ChangeLayer ss "REV")) (princ))
(defun c:SEAL (/ ss) (SetLayerCurrent "SEAL") (and (setq ss (ssget "_I")) (ChangeLayer ss "SEAL")) (princ))
(defun c:TEMPLATE (/ ss) (SetLayerCurrent "TEMPLATE NOTES") (and (setq ss (ssget "_I")) (ChangeLayer ss "TEMPLATE NOTES")) (princ))
(defun c:TEXT (/ ss) (SetLayerCurrent "TEXT") (and (setq ss (ssget "_I")) (ChangeLayer ss "TEXT")) (princ))
(defun SetLayerCurrent(lName / ent elst frz)
 (and
   lName
   (or (setq ent (tblobjname "LAYER" lName))
       (prompt (strcat "\n<!> Can't to find layer \"" lName "\" <!>"))
        [color=red] (command "-LAYER" "M" nl "")
[/color]    (setq elst (entget ent))
   (or (/= 1 (logand 1 (setq frz (cdr (assoc 70 elst)))))
       (and (entmod (subst (cons 70 (boole 6 1 frz)) (assoc 70 elst) elst))
            (vl-cmdf "._regen")
            ))
   (setvar "CLAYER" lNAME)
   (princ (strcat "\n<<< Swiched to \"" lName "\" layer >>>"))
 )
 (princ)
)
(defun ChangeLayer (ss lay / i ename elst)
 (setq i -1)
 (while (setq ename (ssname ss (setq i (1+ i))))
   (setq elst (entget ename))
   (vl-catch-all-apply
       'entmod (list (subst (cons 8 lay) (assoc 8 elst) elst)))
 )
 (princ)
)

 

 

any suggestion?

[CAB]

Give this a try:

;;  set layer current, thaw if necessary
(defun SetLayerCurrent(lName / ent elst frz)
 (and
   lName
   (or (setq ent (tblobjname "LAYER" lName))
       (princ (strcat "\n<!> Can't to find layer \"" lName "\" <!>"))
       (setq lname (getstring t "\nEnter name for NEW layer:"))
       (or
         (setq ent (entmakex (list
                   '(0 . "LAYER")
                   '(100 . "AcDbSymbolTableRecord")
                   '(100 . "AcDbLayerTableRecord")
                   '(70 . 0)
                   (cons 2 lname)
                   '(62 . 7)
                   '(6 . "CONTINUOUS")
         )))
         (prompt "Error: Cound Not create layer.")
       )
   )
   (setq elst (entget ent))
   (or (/= 1 (logand 1 (setq frz (cdr (assoc 70 elst)))))
       (and (entmod (subst (cons 70 (boole 6 1 frz)) (assoc 70 elst) elst))
            (vl-cmdf "._regen")
            ))
   (setvar "CLAYER" lNAME)
   (princ (strcat "\n<<< Swiched to \"" lName "\" layer >>>"))
 )
 (princ)
)

[lisplost]

I tried your code and it doesn't create a new layer when it doesn't find the one requsted in the command. I end up with this in the command line. Power being the layer I want it to create and set current.

 

Can't to find layer "POWER" *Cancel*

bad argument type: lentityp nil

[CAB]

I should have tested it.

 

Try again:

;;  set layer current, thaw if necessary
;;  create it if not found
(defun SetLayerCurrent(lName / ent elst frz)
 (and
   lName
   (or (setq ent (tblobjname "LAYER" lName))
       (prompt (strcat "\n<!> Can't to find layer \"" lName "\" <!>"))
       (or
         (and
           (setq ent (entmakex (list
                   '(0 . "LAYER")
                   '(100 . "AcDbSymbolTableRecord")
                   '(100 . "AcDbLayerTableRecord")
                   '(70 . 0)
                   (cons 2 lname)
                   '(62 . 7)
                   '(6 . "Continuous") ;"CONTINUOUS")
           )))
           (princ (strcat "\n***  New layer created, " lname "  ***")))
         (prompt "Error: Cound Not create layer.")
       )
   )
   (setq elst (entget ent))
   (or (/= 1 (logand 1 (setq frz (cdr (assoc 70 elst)))))
       (and (entmod (subst (cons 70 (boole 6 1 frz)) (assoc 70 elst) elst))
            (vl-cmdf "._regen")
            ))
   (setvar "CLAYER" lNAME)
   (princ (strcat "\n<<< Swiched to \"" lName "\" layer >>>"))
 )
 (princ)
)

[lisplost]

Absolutly perfect! This will make things so much better. Thank you!

[ML0940]

Hi,

I'm not sure if someone gave you the solution you needed but I just tweaked a bit of code that I had written previously.

This code will prompt you (with an input box) to change each layer in the drawing, except layer 0.

 

ML

 

 

Sub ChangeLayName_Inputbox()
Dim lay As AcadLayer
Dim crlayName As String
Dim nwlayName As String

For Each lay In ThisDrawing.Layers
If Not lay.Name = "0" Then 'Filter out Layer 0
Repeatlay:
  crlayName = lay.Name
 'Return to user, layers to renamed
  If MsgBox("Do you want to rename layer " & lay.Name & " ?", vbYesNo, "LayChange") = vbYes Then
  'Prompt the user for new layer name
   nwlayName = InputBox("Enter new layer name for layer " & vbCrLf & lay.Name)
    If nwlayName = "" Then
     MsgBox "All layers must have a name, " & vbCrLf & "Please Click No " & _
     "if you do not want to rename layer: " & vbCrLf & lay.Name, vbCritical
     GoTo Repeatlay
    End If
    lay.Name = nwlayName
    Debug.Print "Layer " & crlayName & " has been changed to " & nwlayName
   End If
 End If
Next lay

Set lay = Nothing

End Sub

[lisplost]

Ok what you gave me Cab worked perfectly. But we want to tweak it a little. Before having created this we had simple commands that changed the layer. Like

 
(defun c:bor () 
(setvar "clayer" "border") 
(princ)
)

When we ran the MakeLayerLisp it indeed created the LayerLISP.lsp with all the layers called out. The thing with that is you have to type the whole name into the command line to get it to change/create and make it come forwards. Well with the previous commands I created to change layers with the command being abreviated in some form this won't work. It shows an error. It was suggested to have my Layers.lsp (like above) load the LayerLISP.lsp and change all the Setvar to (command "border") in hopes of attaching the two lisps together essentially allowing both the abreviated version and the full word to change/create the layer. But this does not work. What can I add to the simple command lisp that will allow both to work without rewriting the Lisp? This is the lisp created with the MakeLayerLisp

 

 
(defun c:BORDER (/ ss) (SetLayerCurrent "BORDER") (and (setq ss (ssget "_I")) (ChangeLayer ss "BORDER")) (princ))

 

My initial thought was to add to this sting a way to call out both names for the layer and make the original abreviated lisp obsolete. Could it be written?

 
(defun c:border (c:bor (/ ss)(setlayerCurrent "border") ( and (setq ss
(ssget "_I")) (ChangeLayer ss "BORDER")) (princ)))

 

Or is it going to have to be in the original MakelayerLisp.lsp?

 

Thanks!

 

 
:;;=======================[ LayerLisp.lsp ]======================= 
;;; Author: Copyright© 2008 Charles Alan Butler 
;;; Version:  1.2 July 2, 2008
;;; Purpose: To create a lisp file for each layer to set current
;;;    and change selected objects layer
;;;==========================================================
;;  Running the c:MakeLayerlisp routine will result in
;;  the File "LayerLISP.lsp" being created in the search path and will
;;  contain lisp routines with a name matching the layers selected with
;;  the Layer name Filter. Then the "LayerLISP.lsp" will be loaded
;;  Running any of these new lisp routines will set current the layer
;;  name you typed to run the lisp & if any objects were pre selected
;;  they will be changed to that layer unless they are on a locked layer
;;  Needed subroutines, must be loaded.
;;  SetLayerCurrent and ChangeLayer
;;  set layer current, thaw if necessary
;;  create it if not found
(defun SetLayerCurrent(lName / ent elst frz)
 (and
   lName
   (or (setq ent (tblobjname "LAYER" lName))
       (prompt (strcat "\n<!> Can't to find layer \"" lName "\" <!>"))
       (or
         (and
           (setq ent (entmakex (list
                   '(0 . "LAYER")
                   '(100 . "AcDbSymbolTableRecord")
                   '(100 . "AcDbLayerTableRecord")
                   '(70 . 0)
                   (cons 2 lname)
                   '(62 . 7)
                   '(6 . "Continuous") ;"CONTINUOUS")
           )))
           (princ (strcat "\n***  New layer created, " lname "  ***")))
         (prompt "Error: Cound Not create layer.")
       )
   )
   (setq elst (entget ent))
   (or (/= 1 (logand 1 (setq frz (cdr (assoc 70 elst)))))
       (and (entmod (subst (cons 70 (boole 6 1 frz)) (assoc 70 elst) elst))
            (vl-cmdf "._regen")
            ))
   (setvar "CLAYER" lNAME)
   (princ (strcat "\n<<< Swiched to \"" lName "\" layer >>>"))
 )
 (princ)
) 

    

;; change the layer of objects to the desired layer
;; will not change objects on locked layers
(defun ChangeLayer (ss lay / i ename elst)
 (setq i -1)
 (while (setq ename (ssname ss (setq i (1+ i))))
   (setq elst (entget ename))
   (vl-catch-all-apply
       'entmod (list (subst (cons 8 lay) (assoc 8 elst) elst)))
 )
 (princ)
)

;;  Routin to make the needed lisp file, contains all the layer names
;;  in the form of a lisp file
(defun c:MakeLayerlisp (/ lst namelst lname acadfn fn fname LayFilter err)
 ;;  -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
 ;;  This is the Filter for Layer names
 ;;  Set to <One String> & <Two Number Characters>
 (setq LayFilter "*")  ; See the HELP file on wcmatch
 ;;  -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-

 ;;  get a list of layer names matching filter
 (while (setq lst (tblnext "layer" (null lst)))
   (if (wcmatch (setq lname (cdr (assoc 2 lst))) LayFilter)
     (setq namelst (cons lname namelst))
   )
 )
 (setq namelst (mapcar '(lambda (x) (nth x namelst)) (vl-sort-i namelst '<)))
 (if (and namelst
          (or (setq acadfn (findfile "ACAD.PAT"))
              (prompt "\nACAD.PAT file not found.")
              (setq acadfn (findfile "ACAD.EXE"))
          ) ; alternate folder location
     )
   (progn
     (prompt (strcat "\nPath to LayerLISP: " (vl-filename-directory acadfn)))
     (setq fname "LayerLISP.lsp"
           fname (strcat (vl-filename-directory acadfn) "\\" fname)
           
     )
     (if (setq fn (open fname "w"))
       (progn
     ;;  create a lisp for each name in one file
     (foreach lname namelst
       (princ (strcat "(defun c:" lname " (/ ss)") fn)
       (princ (strcat " (SetLayerCurrent \"" lname "\")") fn)
       (princ
         (strcat " (and (setq ss (ssget \"_I\")) (ChangeLayer ss \"" lname "\"))")
         fn
       )
       (princ " (princ))" fn)
       (write-line "" fn)
     )   ; end while
     (close fn)
     (princ (strcat "\nLayerLISP.lsp created with " (itoa (length namelst)) " layer routines."))
     (if (vl-catch-all-error-p
           (setq err (vl-catch-all-apply 'load (list fname)))) ; reload the lisp
       (alert (vl-catch-all-error-message err))
       (princ "\nLayerLISP.lsp Loaded. Enter layer names to run.")
     )
       )
       (alert "File failed to open: LayerLISP.lsp")
     )
   )
 )
 (princ)
)

[CAB]

Version 1.4

Read the header

;;;=======================[ LayerLisp.lsp ]======================= 
;;; Author: Copyright© 2008 Charles Alan Butler 
;;; Version:  1.4 Aug 15, 2008
;;; Purpose: To create a lisp file for each layer to set current
;;;    and change selected objects layer
;;;==========================================================

;;  Running the c:MakeLayerlisp routine will result in
;;  the File "LayerLISP.lsp" being created in the search path and will
;;  contain lisp routines with a name matching the layers selected with
;;  the Layer name Filter. Then the "LayerLISP.lsp" will be loaded
;;  Running any of these new lisp routines will set current the layer
;;  name you typed to run the lisp & if any objects were pre selected
;;  they will be changed to that layer unless they are on a locked layer
;;
;;  Ver 1.4 added short cut lisp names. The fitst layer name with >3 
;;  characters will get a 3 character short cut name
;;  i.e.  A-Floor.lsp will also have A-F.lsp
;;
;;  NOTE that layer names may contain space characters but teh lisp names
;;  may not. Therefore the space character is converted to a - for the name

;;  Needed subroutines, must be loaded.
;;  SetLayerCurrent and ChangeLayer

;;  set layer current, thaw if necessary
;;  create it if not found
(defun SetLayerCurrent(lName / ent elst frz)
 (and
   lName
   (or (setq ent (tblobjname "LAYER" lName))
       (prompt (strcat "\n<!> Can't to find layer \"" lName "\" <!>"))
       (or
         (and
           (setq ent (entmakex (list
                   '(0 . "LAYER")
                   '(100 . "AcDbSymbolTableRecord")
                   '(100 . "AcDbLayerTableRecord")
                   '(70 . 0)
                   (cons 2 lname)
                   '(62 . 7)
                   '(6 . "Continuous") ;"CONTINUOUS")
           )))
           (princ (strcat "\n***  New layer created, " lname "  ***")))
         (prompt "Error: Cound Not create layer.")
       )
   )
   (setq elst (entget ent))
   (or (/= 1 (logand 1 (setq frz (cdr (assoc 70 elst)))))
       (and (entmod (subst (cons 70 (boole 6 1 frz)) (assoc 70 elst) elst))
            (vl-cmdf "._regen")
            ))
   (setvar "CLAYER" lNAME)
   (princ (strcat "\n<<< Swiched to \"" lName "\" layer >>>"))
 )
 (princ)
)

;; change the layer of objects to the desired layer
;; will not change objects on locked layers
(defun ChangeLayer (ss lay / i ename elst)
 (setq i -1)
 (while (setq ename (ssname ss (setq i (1+ i))))
   (setq elst (entget ename))
   (vl-catch-all-apply
       'entmod (list (subst (cons 8 lay) (assoc 8 elst) elst)))
 )
 (princ)
)


;;  Routine to make the needed lisp file, contains all the layer names
;;  in the form of a lisp file
(defun c:MakeLayerlisp (/ lst namelst lname acadfn fn fname LayFilter err
                        lastname lastshort lispName SpaceSub)

 ;;  -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
 ;;  This is the Filter for Layer names
 ;;  Set to <One String> & <Two Number Characters>
 ;;(setq LayFilter "?##")  ; See the HELP file on wcmatch
 (setq LayFilter "*")  ; See the HELP file on wcmatch

 ;; Lisp function names may not have a space character in them
 (setq SpaceSub  "-") ; substitute this char for the space character
 ;;  -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-

 
 ;;  get a list of layer names matching filter
 (while (setq lst (tblnext "layer" (null lst)))
   (if (wcmatch (setq lname (cdr (assoc 2 lst))) LayFilter)
     (setq namelst (cons lname namelst))
   )
 )
 (setq namelst (mapcar '(lambda (x) (nth x namelst)) (vl-sort-i namelst '<)))
 (if (and namelst
          (or (setq acadfn (findfile "ACAD.PAT"))
              (prompt "\nACAD.PAT file not found.")
              (setq acadfn (findfile "ACAD.EXE"))
          ) ; alternate folder location
     )
   (progn
     (prompt (strcat "\nPath to LayerLISP: " (vl-filename-directory acadfn)))
     (setq fname "LayerLISP.lsp"
           fname (strcat (vl-filename-directory acadfn) "\\" fname)
           
     )
     (if (setq fn (open fname "w"))
       (progn
     ;;  create a lisp for each name in one file
     (foreach lname namelst
      ;;  Create a shortcut lisp name if no conflict & name > 3 characters
      (if (and lastname (> (strlen lastname) 3)
               (or (null lastshort)
                   (/= (strcase (substr lastname 1 3)) (strcase lastshort)))
               )
        (progn
          ;;  replace space characters with - 
          (write-line (strcat "(defun c:" (vl-string-translate " " SpaceSub (substr lastName 1 3))
                              " () (c:" (vl-string-translate " " SpaceSub lastName) "))") fn)
          (setq lastshort (substr lastname 1 3))
        )
      )
      (setq lastname lname)
      ;;  replace space characters with - 
      (princ (strcat "(defun c:" (vl-string-translate " " SpaceSub lname) " (/ ss)") fn)
       (princ (strcat " (SetLayerCurrent \"" lname "\")") fn)
       (princ
         (strcat " (and (setq ss (ssget \"_I\")) (ChangeLayer ss \"" lname "\"))")
         fn
       )
       (princ " (princ))" fn)
       (write-line "" fn)
     )   ; end foreach
     (close fn)
     (princ (strcat "\nLayerLISP.lsp created with " (itoa (length namelst)) " layer routines."))
     (if (vl-catch-all-error-p
           (setq err (vl-catch-all-apply 'load (list fname)))) ; reload the lisp
       (alert (vl-catch-all-error-message err))
       (princ "\nLayerLISP.lsp Loaded. Enter layer names to run.")
     )
       )
       (alert "File failed to open: LayerLISP.lsp")
     )
   )
 )
 (princ)
)


;;  Load the lisp if one already exist
(if (vl-catch-all-error-p
     (setq err (vl-catch-all-apply 'load (list "LayerLISP.lsp")))) 
 (alert (vl-catch-all-error-message err))
 (princ "\nLayerLISP.lsp Loaded. Enter layer names to run.")
)

[CAB]

Another version.

Attempting to prevent lisp naming conflicts with existing routines.

Example: you have a layer named LINE. If the routine created a new lisp named c:Line

it would disable the LINE command. The new version prevents that.

;;;=======================[ LayerLisp.lsp ]======================= 
;;; Author: Copyright© 2008 Charles Alan Butler 
;;; Version:  1.5 Aug 16, 2008
;;; Purpose: To create a lisp file for each layer to set current
;;;    and change selected objects layer
;;;==========================================================

;;  Running the c:MakeLayerlisp routine will result in
;;  the File "LayerLISP.lsp" being created in the search path and will
;;  contain lisp routines with a name matching the layers selected with
;;  the Layer name Filter. Then the "LayerLISP.lsp" will be loaded
;;  Running any of these new lisp routines will set current the layer
;;  name you typed to run the lisp & if any objects were pre selected
;;  they will be changed to that layer unless they are on a locked layer
;;
;;  Ver 1.4 added short cut lisp names. The fitst layer name with >3 
;;  characters will get a 3 character short cut name
;;  i.e.  A-Floor.lsp will also have A-F.lsp
;;
;;  NOTE that layer names may contain space characters but teh lisp names
;;  may not. Therefore the space character is converted to a - for the name
;;
;;  Ver 1.5 added test for conflict with existing routines
;;  the down side is that if the LayerLisp has been loaded then another
;;  run of this routine will ignore existing lisp routine with the same
;;  layer name. To get a full list in the LayerLisp file you must close the
;;  DWG & reopen it & then run this routine again.



;;  Needed subroutines, must be loaded.
;;  SetLayerCurrent and ChangeLayer

;;  set layer current, thaw if necessary
;;  create it if not found
(defun SetLayerCurrent(lName / ent elst frz)
 (and
   lName
   (or (setq ent (tblobjname "LAYER" lName))
       (prompt (strcat "\n<!> Can't to find layer \"" lName "\" <!>"))
       (or
         (and
           (setq ent (entmakex (list
                   '(0 . "LAYER")
                   '(100 . "AcDbSymbolTableRecord")
                   '(100 . "AcDbLayerTableRecord")
                   '(70 . 0)
                   (cons 2 lname)
                   '(62 . 7)
                   '(6 . "Continuous") ;"CONTINUOUS")
           )))
           (princ (strcat "\n***  New layer created, " lname "  ***")))
         (prompt "Error: Cound Not create layer.")
       )
   )
   (setq elst (entget ent))
   (or (/= 1 (logand 1 (setq frz (cdr (assoc 70 elst)))))
       (and (entmod (subst (cons 70 (boole 6 1 frz)) (assoc 70 elst) elst))
            (vl-cmdf "._regen")
            ))
   (setvar "CLAYER" lNAME)
   (princ (strcat "\n<<< Swiched to \"" lName "\" layer >>>"))
 )
 (princ)
)

;; change the layer of objects to the desired layer
;; will not change objects on locked layers
(defun ChangeLayer (ss lay / i ename elst)
 (setq i -1)
 (while (setq ename (ssname ss (setq i (1+ i))))
   (setq elst (entget ename))
   (vl-catch-all-apply
       'entmod (list (subst (cons 8 lay) (assoc 8 elst) elst)))
 )
 (princ)
)


;;  Routine to make the needed lisp file, contains all the layer names
;;  in the form of a lisp file
;;  Note that if the layer name conflicts with an existing lisp routine name
;;  it will not be created
(defun c:MakeLayerlisp (/ lst namelst lname acadfn fn fname LayFilter err
                        lastname lastshort lispName SpaceSub cnt sc-cnt)

 ;;  -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
 ;;  This is the Filter for Layer names
 ;;  Set to <One String> & <Two Number Characters>
 ;;(setq LayFilter "?##")  ; See the HELP file on wcmatch
 (setq LayFilter "*")  ; See the HELP file on wcmatch

 ;; Lisp function names may not have a space character in them
 (setq SpaceSub  "-") ; substitute this char for the space character
 ;;  -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-

 
 ;;  get a list of layer names matching filter
 (while (setq lst (tblnext "layer" (null lst)))
   (if (wcmatch (setq lname (cdr (assoc 2 lst))) LayFilter)
     (setq namelst (cons lname namelst))
   )
 )
 (setq namelst (mapcar '(lambda (x) (nth x namelst)) (vl-sort-i namelst '<)))
 (if (and namelst
          (or (setq acadfn (findfile "ACAD.PAT"))
              (prompt "\nACAD.PAT file not found.")
              (setq acadfn (findfile "ACAD.EXE"))
          ) ; alternate folder location
     )
   (progn
     (prompt (strcat "\nPath to LayerLISP: " (vl-filename-directory acadfn)))
     (setq fname "LayerLISP.lsp"
           fname (strcat (vl-filename-directory acadfn) "\\" fname)
           cnt   0
           sc-cnt 0
     )
     (if (setq fn (open fname "w"))
       (progn
         ;;  create a lisp for each name in one file
         (foreach lname namelst
          ;;  Create a shortcut lisp name if no conflict & name > 3 characters
          (if (and lastname (> (strlen lastname) 3)
                   (or (null lastshort)
                       (/= (strcase (substr lastname 1 3)) (strcase lastshort)))
                   (or (null (car (atoms-family 1 (list (strcat "c:"(substr lastname 1 3))))))
                       (prompt (strcat "\nName already exist: " (substr lastname 1 3))))
                   )
            (progn
              ;;  replace space characters with - 
              (write-line (strcat "(defun c:" (vl-string-translate " " SpaceSub (substr lastName 1 3))
                                  " () (c:" (vl-string-translate " " SpaceSub lastName) "))") fn)
              (setq lastshort (substr lastname 1 3))
              (setq sc-cnt (1+ sc-cnt))
            )
          )
          (setq lastname lname)
          (if (car (atoms-family 1 (list (strcat "c:"(vl-string-translate " " SpaceSub lname)))))
            (prompt (strcat "\nName already exist: " (vl-string-translate " " SpaceSub lname)))
            (progn
              ;;  replace space characters with - 
              (princ (strcat "(defun c:" (vl-string-translate " " SpaceSub lname) " (/ ss)") fn)
              (princ (strcat " (SetLayerCurrent \"" lname "\")") fn)
              (princ
                (strcat " (and (setq ss (ssget \"_I\")) (ChangeLayer ss \"" lname "\"))")
                fn
              )
              (princ " (princ))" fn)
              (write-line "" fn)
              (setq cnt (1+ cnt))
            )
           )
         )   ; end foreach
         (close fn)
         (princ (strcat "\nLayerLISP.lsp created with " (itoa cnt) " layer routines."))
         (princ (strcat "\nCreated " (itoa sc-cnt) " shortcut routines."))
         (princ (strcat "\nRejected " (itoa (- (length namelst) cnt)) " layer names."))
         (if (vl-catch-all-error-p
               (setq err (vl-catch-all-apply 'load (list fname)))) ; reload the lisp
           (alert (vl-catch-all-error-message err))
           (princ "\nLayerLISP.lsp Loaded. Enter layer names to run.")
         )
       )
       (alert "File failed to open: LayerLISP.lsp")
     )
   )
 )
 (princ)
)

(c:MakeLayerlisp) ; run the routine when the drawing is opened
;;  this will overwrite the existing file


;|  do not use the following code

;;  Load the lisp if one already exist
(if (vl-catch-all-error-p
     (setq err (vl-catch-all-apply 'load (list "LayerLISP.lsp")))) 
 (alert (vl-catch-all-error-message err))
 (princ "\nLayerLISP.lsp Loaded. Enter layer names to run.")
)

|;

[lisplost]

Thanks! I'll give it a shot and see how it goes.

[lisplost]

Thanks for your help.

It created the layer name but we tweaked it a little to bypass the step where it didn't recognize the layers with similar names such as power and power future. Instead we had it take the first three letters and then the last letter and create the short cut to add the last letter to any that were similar. We also adjusted it to adapt to the layers that were numbered. Such as Power1 and so forth. So the shortcut becomes pow1 instead of skiping it because the layer name was similar to another. Our next goal is to have the code look for existing marcos and codes that might interfere with the layer name shortcuts. Such as we have a layer called receptacles, the shortcut is rec. Well rec is the preexisting shortcut for rectangle. So the goal is to have the code search for all marcos or commands that are similar to our layer names. Currently there are 3 that we know of. Since codes accept the newest code and overwrite old we want to stop that before it happens. Ideal we want to keep the shortcuts to 3 letters and a number. What do you suggest we do to make this happen. I will send the code that we have done already and please tell us where we can insert the new addition.

 

Thanks.

[lisplost]

;;;=======================[ LayerLisp.lsp ]======================= 
;;; Author: Copyright© 2008 Charles Alan Butler 
;;; Version:  1.5 Aug 16, 2008
;;; Purpose: To create a lisp file for each layer to set current
;;;    and change selected objects layer
;;;==========================================================
;;  Running the c:MakeLayerlisp routine will result in
;;  the File "LayerLISP.lsp" being created in the search path and will
;;  contain lisp routines with a name matching the layers selected with
;;  the Layer name Filter. Then the "LayerLISP.lsp" will be loaded
;;  Running any of these new lisp routines will set current the layer
;;  name you typed to run the lisp & if any objects were pre selected
;;  they will be changed to that layer unless they are on a locked layer
;;
;;  Ver 1.4 added short cut lisp names. The fitst layer name with >3 
;;  characters will get a 3 character short cut name
;;  i.e.  A-Floor.lsp will also have A-F.lsp
;;
;;  NOTE that layer names may contain space characters but teh lisp names
;;  may not. Therefore the space character is converted to a - for the name
;;
;;  Ver 1.5 added test for conflict with existing routines
;;  the down side is that if the LayerLisp has been loaded then another
;;  run of this routine will ignore existing lisp routine with the same
;;  layer name. To get a full list in the LayerLisp file you must close the
;;  DWG & reopen it & then run this routine again.

;;  Needed subroutines, must be loaded.
;;  SetLayerCurrent and ChangeLayer
;;  set layer current, thaw if necessary
;;  create it if not found

;;  Routine to make the needed lisp file, contains all the layer names
;;  in the form of a lisp file
;;  Note that if the layer name conflicts with an existing lisp routine name
;;  it will not be created
(defun c:MakeLayerlisp (/ lst namelst lname acadfn fn fname LayFilter err
                        lastname lastshort lispName SpaceSub cnt sc-cnt)
 ;;  -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
 ;;  This is the Filter for Layer names
 ;;  Set to <One String> & <Two Number Characters>
 ;;(setq LayFilter "?##")  ; See the HELP file on wcmatch
 (setq LayFilter "*")  ; See the HELP file on wcmatch
 ;; Lisp function names may not have a space character in them
 (setq SpaceSub  "-") ; substitute this char for the space character
 ;;  -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
 
 ;;  get a list of layer names matching filter
 (while (setq lst (tblnext "layer" (null lst)))
   (if (wcmatch (setq lname (cdr (assoc 2 lst))) LayFilter)
     (setq namelst (cons lname namelst))
   )
 )
 (setq namelst (mapcar '(lambda (x) (nth x namelst)) (vl-sort-i namelst '<)))
 (if (and namelst
          (or (setq acadfn (findfile "LAYERLISP.LSP"))
              (prompt "\nACAD.PAT file not found.")
              (setq acadfn (findfile "ACAD.EXE"))
          ) ; alternate folder location
     )
   (progn
     (prompt (strcat "\nPath to LayerLISP: " (vl-filename-directory acadfn)))
     (setq fname "LayerLISP.lsp"
           fname (strcat (vl-filename-directory acadfn) "\\" fname)
           cnt   0
           sc-cnt 0
     )
     (if (setq fn (open fname "w"))
       (progn
         ;;  create a lisp for each name in one file
         (foreach lname namelst
          ;;  Create a shortcut lisp name if no conflict & name > 3 characters
          (if (and lastname (> (strlen lastname) 3)
                   ;;(or (null lastshort)
                       ;;(/= (strcase (substr lastname 1 3)) (strcase lastshort)))
                   (or (null (car (atoms-family 1 (list (strcat "c:"(substr lastname 1 3))))))
                      (prompt (strcat "\nName already exist: " (substr lastname 1 3))))
              )
            (progn
              ;;  replace space characters with - 
       (if (or (null lastshort) (/= (strcase (substr lastname 1 3)) (strcase lastshort)))
                (write-line (strcat "(defun c:" (vl-string-translate " " SpaceSub (substr lastName 1 3)) " () (c:" (vl-string-translate " " SpaceSub lastName) "))") fn)
                (write-line (strcat "(defun c:" (vl-string-translate " " SpaceSub (substr lastName 1 3)) (substr lastName (strlen lastname) 1) " () (c:" (vl-string-translate " " SpaceSub lastName) "))") fn)
       );;
              (setq lastshort (substr lastname 1 3))
              (setq sc-cnt (1+ sc-cnt))
            )
          )
          (setq lastname lname)
          (if (car (atoms-family 1 (list (strcat "c:"(vl-string-translate " " SpaceSub lname)))))
            (prompt (strcat "\nName already exist: " (vl-string-translate " " SpaceSub lname)))
            (progn
              ;;  replace space characters with - 
              (princ (strcat "(defun c:" (vl-string-translate " " SpaceSub lname) " (/ ss)") fn)
              (princ (strcat " (SetLayerCurrent \"" lname "\")") fn)
              (princ
                (strcat " (and (setq ss (ssget \"_I\")) (ChangeLayer ss \"" lname "\"))")
                fn
              )
              (princ " (princ))" fn)
              (write-line "" fn)
              (setq cnt (1+ cnt))
            )
           )
         )   ; end foreach
  (write-line "" fn)
  (write-line "(defun SetLayerCurrent(lName / ent elst frz)" fn)
  (write-line "  (and" fn)
  (write-line "    lName" fn)
  (write-line "    (or (setq ent (tblobjname \"LAYER\" lName))" fn)
  (write-line "        (prompt (strcat \"[url="file://\\n"]\\n[/url]<!> Can't to find layer \\\"\" lName \"\\\" <!>\"))" fn)
  (write-line "        (or" fn)
  (write-line "          (and" fn)
  (write-line "            (setq ent (entmakex (list" fn)
  (write-line "                    '(0 . \"LAYER\")" fn)
  (write-line "                    '(100 . \"AcDbSymbolTableRecord\")" fn)
  (write-line "                    '(100 . \"AcDbLayerTableRecord\")" fn)
  (write-line "                    '(70 . 0)" fn)
  (write-line "                    (cons 2 lname)" fn)
  (write-line "                    '(62 . 7)" fn)
  (write-line "                    '(6 . \"Continuous\") ;\"CONTINUOUS\")" fn)
  (write-line "            )))" fn)
  (write-line "            (princ (strcat \"[url="file://\\n"]\\n[/url]***  New layer created, \" lname \"  ***\")))" fn)
  (write-line "          (prompt \"Error: Cound Not create layer.\")" fn)
  (write-line "        )" fn)
  (write-line "    )" fn)
  (write-line "    (setq elst (entget ent))" fn)
  (write-line "    (or (/= 1 (logand 1 (setq frz (cdr (assoc 70 elst)))))" fn)
  (write-line "        (and (entmod (subst (cons 70 (boole 6 1 frz)) (assoc 70 elst) elst))" fn)
  (write-line "             (vl-cmdf \"._regen\")" fn)
  (write-line "             ))" fn)
  (write-line "    (setvar \"CLAYER\" lNAME)" fn)
  (write-line "    (princ (strcat \"[url="file://\\n"]\\n[/url]<<< Swiched to \\\"\" lName \"\\\" layer >>>\"))" fn)
  (write-line "  )" fn)
  (write-line "  (princ)" fn)
  (write-line ")" fn)
  (write-line "" fn)
  (write-line ";; change the layer of objects to the desired layer" fn)
  (write-line ";; will not change objects on locked layers" fn)
         (write-line "(defun ChangeLayer (ss lay / i ename elst)" fn)
         (write-line "(setq i -1)" fn)
         (write-line "(while (setq ename (ssname ss (setq i (1+ i))))" fn)
         (write-line "(setq elst (entget ename))" fn)
         (write-line "(vl-catch-all-apply" fn)
         (write-line "'entmod (list (subst (cons 8 lay) (assoc 8 elst) elst)))" fn)
         (write-line ")" fn)
         (write-line "(princ)" fn)
         (write-line ")" fn)
         (close fn)
         (princ (strcat "\nLayerLISP.lsp created with " (itoa cnt) " layer routines."))
         (princ (strcat "\nCreated " (itoa sc-cnt) " shortcut routines."))
         (princ (strcat "\nRejected " (itoa (- (length namelst) cnt)) " layer names."))
         (if (vl-catch-all-error-p
               (setq err (vl-catch-all-apply 'load (list fname)))) ; reload the lisp
           (alert (vl-catch-all-error-message err))
           (princ "\nLayerLISP.lsp Loaded. Enter layer names to run.")
         )
       )
       (alert "File failed to open: LayerLISP.lsp")
     )
   )
 )
 (princ)
)
(c:MakeLayerlisp) ; run the routine when the drawing is opened
;;  this will overwrite the existing file

;|  do not use the following code
;;  Load the lisp if one already exist
(if (vl-catch-all-error-p
     (setq err (vl-catch-all-apply 'load (list "LayerLISP.lsp")))) 
 (alert (vl-catch-all-error-message err))
 (princ "\nLayerLISP.lsp Loaded. Enter layer names to run.")
)
|;