Changing layer by typing the layer name

[CAB]

Try this version, but does not contain your mods.

;;;=======================[ LayerLisp.lsp ]======================= 
;;; Author: Copyright© 2008 Charles Alan Butler 
;;; Version:  1.6 Sep 11, 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.
;;
;;  Ver 1.6 added test for conflict with Commands & Aliases



;;  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)
)

;;  by SMadson modified by CAB
(defun ShortcutExist? (shortcut / chrlst ln pgp pgpfo pos)
 (cond ((setq pgp (findfile "acad.pgp"))
        (setq pgpfo (open pgp "r"))
        (while (setq ln (read-line pgpfo))
          (and (/= (substr ln 1 1) ";")
               (setq pos (vl-string-position (ascii ",") ln))
               (setq chrlst (cons (substr ln 1 pos) chrlst))
          )
        )
        (close pgpfo)
       )
 )
 (car (member (strcase shortcut) (mapcar 'strcase chrlst)))
)


;;  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) ; allow < 3 characters
                   (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 exist as a function: " (substr lastname 1 3))))
                   (or (null (getcname lname))
                       (prompt (strcat "\nName exist as command: " (substr lastname 1 3))))
                   (or (null (ShortcutExist? (substr lastname 1 3)))
                       (prompt (strcat "\nName exist as shortcut: " (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 (or (car (atoms-family 1 (list (strcat "c:"(vl-string-translate " " SpaceSub lname)))))
                  (getcname 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

[lisplost]

Thanks, I will give it a shot.

[chauncy274]

It looks like all of these ideas are good, but if you don't want to go through the trouble, I just use the laymcur command (of course i gave it a smaller alias for speed) and then you can select any object and it sets the current layer to whatever you select. I tried making lisps and scripts for what your doing but we use way to many layers for each dept. Hope it helps!

[lisplost]

It looks like all of these ideas are good, but if you don't want to go through the trouble, I just use the laymcur command (of course i gave it a smaller alias for speed) and then you can select any object and it sets the current layer to whatever you select. I tried making lisps and scripts for what your doing but we use way to many layers for each dept. Hope it helps!

 

 

I don't know what this is. And this is a long process and Cadd has done 90% of the writing for me! Seems like every time I think it is what my co-worker wants he has a new way of doing it, wants to improve it. That is all good, I don't have that kind of vision he does. I think hey if it works awesome! So now we are still having trouble with the existing commands. The code will not over write them, but it won't create something new or different either. We have tried several differen't things, and they are so close but there is always one little part that doesn't work. So it we have to start over. When I say we I mean him, because it takes his brain for me to even grasp it. He has to break it down for me :wink:!

So if there is something out there that I can figure out a little easier I am all for it. Just so long as I don't have to start over from scratch.

 

Thanks!