Simple lisp function that creates new layers

[jeremiahwuzza]

Here is a simple AutoLISP program I wrote that creates new layers in the format 'House - Walls - Structure' (for example).

(defun SCASE (instr /) ;sentence case
(strcat (strcase (substr instr 1 1)) (substr instr 2)))
; - - - - - -
(defun C:LNR (/ lname inp) ;LayerNameR
(setq div " - "
inp (scase (getstring T "Enter first part:")))
(while (/= inp "")
(if lname
(setq lname (strcat lname div inp))(setq lname inp))
(setq inp (scase (getstring T "Enter next part:"))))
;exit while loop - put color picker here
(command "-layer" "n" lname "S" lname "")
(princ))

What I want to do is be able to pick a color for the new layer using the standard 256 color picker. It is beyond my simple lisp skills but it must be possible - musn't it? A pop-up color picker?
Any suggestions?

[ВeekeeCZ · Accepted solution]

There is a built-in function for that, it's very easy to use. Look HERE

[rolisonfelipe]

Type 01

(defun C:LL () ( c:LAYER_UP ))
(defun c:LAYER_UP ()
(command "layer" "m" "LAYER NAME1" "lt" "continuous" "" "c" "1" "" "") ; 1 RED
(command "layer" "m" "LAYER NAME2" "lt" "continuous" "" "c" "2" "" "") ; 2 YELLOW
(command "layer" "m" "LAYER NAME3" "lt" "continuous" "" "c" "3" "" "") ; 3 GREE COLOR
(command "layer" "m" "LAYER NAME4" "lt" "continuous" "" "c" "4" "" "") ; 3 CYAN COLOR
(command "layer" "m" "LAYER NAME5....N+1NAME" "lt" "continuous" "" "c" "5" "" "") ; 3 BLUE COLOR
(princ)
)

Type 02

(defun c:NL ( / *error* check_name acdoc ss fname op_file dcl name r i la col)
  (if (setq ss (ssget "_I")) (setq ss (ssget ":L")))

  (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))

  (if (= 8 (logand (getvar 'undoctl) 8)) (vla-endundomark acDoc))
  (vla-startundomark acDoc)

  (defun *error* (msg)
    (and
      msg
      (not (wcmatch (strcase msg) "*CANCEL*,*EXIT*,*QUIT*,*BREAK*"))
      (princ (strcat "\nError: " msg))
      )
    (if fname (vl-catch-all-apply 'vl-file-delete (list fname)))
    (vla-endundomark acDoc)
    (princ)
  )

  (setq
    fname (vl-filename-mktemp "newlayer" (getvar 'dwgprefix) ".dcl")
    op_file (open fname "w")
  )

  (foreach x
    '("newlayer : dialog {"
      ": edit_box {alignment = left; key = \"name\"; edit_width = 50;}"
      ": text { alignment =right; label = \"ADDLAYER/COLOR\";}"
      "ok_cancel;"
      "errtile;}"
     )
    (write-line x op_file)
  )
  (close op_file)
 
  (defun check_name (str)
    (if
      (wcmatch str "*<*,*>*,*/*,*\\*,*:*,*;*,*`?*,*`**,*|*,*`,*,*=*,*``*")
      (progn
        (set_tile "error" "Caracter Invalido, Não Use <>/\\\":;?*|,=`")
        (mode_tile "name" 2)
        )
      (set_tile "error" "")
      )
    )

  (if
    (and
      (> (setq dcl (load_dialog fname)) 0)
      (new_dialog "newlayer" dcl)
      )
    (progn
      (set_tile "name" (setq name (cond (ss (cdr (assoc 8 (entget (ssname ss 0))))) (""))))
      (action_tile "name" "(setq name $value) (check_name name)")
      (setq r (start_dialog))
      (unload_dialog dcl)
      )
    )
  (if
    (and
      (= r 1)
      (/= name "")
      )
    (progn
      (if
        (not (tblsearch "layer" name))
        (progn
          (setq la (vla-add (vla-get-layers acdoc) name))
          (if
            (setq col (acad_colordlg 7))
            (vla-put-color la col)
            )
          T
          )
        (setq la (vla-item (vla-get-layers acdoc) name))
        )
      (if
        (/= name (getvar 'clayer))
        (progn
          (vla-put-freeze la :vlax-false)
          (setvar 'clayer name)
          )
        )
      (if ss
        (repeat (setq i (sslength ss))
          (vla-put-layer (vlax-ename->vla-object (ssname ss (setq i (1- i)))) name)
          )
        )    
      )
    )
  (*error* nil)
  (princ)
  )

[jeremiahwuzza]

Thanks for that - I didn't think of looking in the obvious place. Here's my modified code:

; - - - - - -
(defun SCASE (instr /) ;sentence case
(strcat (strcase (substr instr 1 1)) (substr instr 2)))
; - - - - - -
(defun C:LNR (/ lname inp) ;LayerNameR
(setq div " - "
inp (scase (getstring T "Enter first part:")))
(while (/= inp "")
(if lname
(setq lname (strcat lname div inp))(setq lname inp))
(setq inp (scase (getstring T "Enter next part:"))))
(setq col (acad_colordlg 5 nil)) ; defaults to Blue with no bylayer or byblock otions
(command "-layer" "n" lname "S" lname "C" col "" "")
(princ))
; - - - - - -

Works well.

[scot-65]

What happens to your little routine if one enters a layer name that already exists?

- Gather user input.
- Test user input.
- If test passes, execute.

What you show does not follow this simple structure.
To see what I mean, select the "Cancel" button in the color dialog.

???

[jeremiahwuzza]

I tried to bug it but it worked anyway. I entered the same name, changed the color and it silently changed the color on that name. If I cancelled the color dialog box it made the color the default (blue in this case).
I know it doesn't follow the structure you show, but it works for me.
it will do for now!

Thanks for your comment anyway - I consider it in future programs.

Jez