New Layer

New Layer

jorgearone_inssitu
Enthusiast Enthusiast
349 Views
2 Replies
Message 1 of 3

New Layer

jorgearone_inssitu
Enthusiast
Enthusiast

Hello everyone
I would like to create a lisp that creates a new layer
1. On the command line ask for the name
2. Please request the color, by the color chart, as below.

jorgearone_inssitu_0-1690409884525.png

3. request the lineweight, on the command line.

 

 

This code is on the Internet, but it asks for the name in a text box, and it doesn't ask for the lineweight.

 

(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 {"
": spacer { height = 1;}"
": text { alignment = left; label = \"Enter Layer Name\";}"
": edit_box {alignment = left; key = \"name\"; edit_width = 40;}"
": spacer { height = 1;}"
"ok_cancel;"
"errtile;}"
)
(write-line x op_file)
)
(close op_file)

(defun check_name (str)
(if
(wcmatch str "*<*,*>*,*/*,*\\*,*:*,*;*,*`?*,*`**,*|*,*`,*,*=*,*``*")
(progn
(set_tile "error" "Invalid character. Do not 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))))) ("New Layer"))))
(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)
)

0 Likes
Accepted solutions (2)
350 Views
2 Replies
Replies (2)
Message 2 of 3

ВeekeeCZ
Consultant
Consultant
Accepted solution

Possibly like this..

 

(defun c:NewLayer ( / n c w)

  (if (and (setq n (getstring t "\nLayer name: "))
	   (or (snvalid n 0)
	       (prompt "\nError: Name with invalid characters"))
	   (or (not (tblsearch "LAYER" n))
	       (initget "Yes")
	       (getkword "Layer already exists. Redefine? [Yes] <no>: "))
	   (setq c (acad_colordlg 0))
	   (setq w (getreal "\nEnter lineweight (0.0mm - 2.11mm): "))
	   )
    (command-s "_-layer" "_n" n "_c" c n "_lw" w n ""))
  (princ)
  )

 

0 Likes
Message 3 of 3

Kent1Cooper
Consultant
Consultant
Accepted solution

Is not this enough?

 

(defun C:NLCW () ; = New Layer with Color and lineWeight

  (command "_.layer" "_make" pause "_color" (acad_colordlg 7 T) "" "_lweight" pause "" "")

  (prin1)

)

Kent Cooper, AIA
0 Likes