Automatic Layer Creation

March 23, 2020

just a wild thought :

Is it possible to create layers based on the selected texts?
If the layer exist, skip. if it does not create it.

Example i have selected multiple text/mtext

Quote

TEST-01
TEST-03
TEST-03
TEST-04
TEST-05

I need to assign a prefix and suffix as per the company's standard layering format

Quote

prefix : A-_
suffix : -N

Final Layer name outcome :

Quote

A-_TEST01-N
A-_TEST02-N
A-_TEST03-N
A-_TEST04-N
A-_TEST05-N

March 23, 2020

Did you do any sort of google or search here for "does layer exist" its all out there, hint (tblobjname "layer" lname), the text string again hint "Get text string". oh don't forget (strcat good time to learn.

March 23, 2020

I have this routine which creates the XREF layer.

Can this be edited to achieve the above query?

(defun c:Xlay (/ cmd1)
(setq cmd1 (getvar 'cmdecho))
(setvar 'cmdecho 0)
(if
  (not
     (tblsearch "LAYER" "XREF")
  )
  (command "-layer" "new" "XREF" "C" "7" "XREF" "")
 )
(command "-layer" "set" "XREF" "")
(setvar 'cmdecho cmd1)
(print "XREF Layer now created and made current! ")
(princ)
)

March 23, 2020

This in conjunction with what you have (tblobjname "layer" lname) just try it with a known and unknown lname.

March 23, 2020

Two more things to consider.

1st Use arguments in your lisp for layer name:

(defun PreLaySuf (Lay / cmd1)
	(setq cmd1 (getvar 'cmdecho)
	      Lay (strcat "A-_" Lay "-N")
	)
)

so that one lisp could be used in a macro for any layer:

(PreLaySuf "TEST01")
(PreLaySuf "TEST02")

2nd If these layers already exist in a drawing or template use Lee Mac's http://www.lee-mac.com/steal.html to insert that list of layers into your drawing with something like:

(Steal (strcat (vl-filename-directory (getenv "QnewTemplate")) (chr 92) "AutoCAD Template" (chr 92) "Templates.dwt") 
(list (list "layers" (list "A-_TEST01-N" "A-_TEST02-N" "A-_TEST03-N" "A-_TEST04-N" "A-_TEST05-N"))))

March 23, 2020

Try following code :

(defun layer (name)
  (entmake (list
	     '(0 . "LAYER")
	     (cons 100 "AcDbSymbolTableRecord")
	     (cons 100 "AcDbLayerTableRecord")
	     (cons 2 name)
	     (cons 70 0)
	     (cons 62 7)
	     (cons 6 "Continuous")
	   )
  )
)

(setq p "A-_")
(setq s "-N")
(foreach x '("TEST-01" "TEST-02" "TEST-03" "TEST-04" "TEST-05")
  (if (not (tblsearch "layer" x))
    (layer (strcat p x s))
  )
)

Edited March 23, 2020 by satishrajdev

March 23, 2020

21 minutes ago, satishrajdev said:

Try following code :


(defun layer (name)
  (entmake (list
	     '(0 . "LAYER")
	     (cons 100 "AcDbSymbolTableRecord")
	     (cons 100 "AcDbLayerTableRecord")
	     (cons 2 name)
	     (cons 70 0)
	     (cons 62 7)
	     (cons 6 "Continuous")
	   )
  )
)

(setq p "A-_")
(setq s "-N")
(foreach x '("TEST-01" "TEST-02" "TEST-03" "TEST-04" "TEST-05")
  (if (not (tblsearch "layer" x))
    (layer (strcat p x s))
  )
)

Thanks for this.

Edited March 23, 2020 by nod684

March 23, 2020

(defun c:test (/ ss i p s en Text)
  (setq ss (ssget '((0 . "Text"))))
  (setq i 0)
  (setq p "A-_")
  (setq s "-N")
  (repeat (sslength ss)
    (setq en   (ssname ss i)
	  Text (get_dxf en 1)
	  i    (1+ i)
    )
  (entmake (list
	     '(0 . "LAYER")
	     (cons 100 "AcDbSymbolTableRecord")
	     (cons 100 "AcDbLayerTableRecord")
	     (cons 2 (strcat p Text s))
	     (cons 70 0)
	     (cons 62 7)
	     (cons 6 "Continuous")
	   )
  )		
    )
  (princ)
)
(princ)

(defun get_dxf (en num /)
  (cdr (assoc num (entget en)))
)

Try following code

March 24, 2020

Now you have the answer this is what I would use (chklay1 lay) that's it 1 line as the defun chklay is in my autoloaded library lisp. So chklay is available for every lisp I write. (chklay2 lay col lt)

March 24, 2020

9 hours ago, myloveflyer said:


(defun c:test (/ ss i p s en Text)
  (setq ss (ssget '((0 . "Text"))))
  (setq i 0)
  (setq p "A-_")
  (setq s "-N")
  (repeat (sslength ss)
    (setq en   (ssname ss i)
	  Text (get_dxf en 1)
	  i    (1+ i)
    )
  (entmake (list
	     '(0 . "LAYER")
	     (cons 100 "AcDbSymbolTableRecord")
	     (cons 100 "AcDbLayerTableRecord")
	     (cons 2 (strcat p Text s))
	     (cons 70 0)
	     (cons 62 7)
	     (cons 6 "Continuous")
	   )
  )		
    )
  (princ)
)
(princ)

(defun get_dxf (en num /)
  (cdr (assoc num (entget en)))
)

Try following code

Hi Thanks, tried this but it did not create any layer after selecting multiple text...

March 24, 2020

5 hours ago, CAD_Noob said:

Hi Thanks, tried this but it did not create any layer after selecting multiple text...

perhaps TEXT string invalid for symbol table? or formatted MTEXT?

example:

<TEST-00
TEST-01>
TEST:02
TEST 03*10
TEST 04,05
TEST-05?
TEST=06
TEST|07
TEST-08/08

TEST-09\\P10

use snvalid to validate

(defun c:tt (/ $ ok str doc lays ss)
  (and (ssget "_:L" '((0 . "*TEXT")))
    (vlax-for obj (setq doc  (vla-get-ActiveDocument (vlax-get-acad-object)) lays (vla-get-layers (vla-get-Database doc ))
      					ss (vla-get-ActiveSelectionSet doc))
      (setq str	(vla-get-TextString obj) $ str )
      (if (and
	    (setq ok (snvalid str))
	    (not (tblsearch "LAYER" str))
	    (not (tblsearch "LAYER" (setq $ (strcat "A-_" str "-N"))))
	  )
	(progn (vla-add lays $)
	       (princ (strcat "\nNew layer created : " $))
	)
	(princ (if (not ok)
		 "\nInvalid name! "
		 (strcat "\nLayer exists : " $)
	       )
	)
      )
      (progn (vla-put-layer obj $) (vla-put-color obj AcRed) ); change to new layer
    )
  )
  (vl-catch-all-apply 'vlax-release-object (list ss))
  (princ)
)

Edited March 24, 2020 by hanhphuc
release object, vla-put-color

March 24, 2020

21 minutes ago, hanhphuc said:

perhaps TEXT string invalid for symbol table? or formatted MTEXT?

example:

<TEST-00
TEST-01>
TEST:02
TEST 03*10
TEST 04,05
TEST-05?
TEST=06
TEST|07
TEST-08/08

TEST-09\\P10

use snvalid to validate


(defun c:tt (/ $ ok str doc lays)
  (and (ssget "_:L" '((0 . "*TEXT")))
    (setq doc  (vla-get-ActiveDocument (vlax-get-acad-object))
	  lays (vla-get-layers (vla-get-Database doc )
	       )
    )
    (vlax-for obj (vla-get-ActiveSelectionSet doc)
      (setq str	(vla-get-TextString obj) $ str )
      (if (and
	    (setq ok (snvalid str))
	    (not (tblsearch "LAYER" str))
	    (not (tblsearch "LAYER" (setq $ (strcat "A-_" str "-N"))))
	  )
	(progn (vla-add lays $)
	       (princ (strcat "\nNew layer created : " $))
	)
	(princ (if (not ok)
		 "\nInvalid name! "
		 (strcat "\nLayer exists : " $)
	       )
	)
      )
      (if ok (vla-put-layer obj $)) ; change to new layer
    )
  )
  (princ)
)

Thanks! this one worked!

Just need now to manually assign the color.

Don't know if this can be integrated with the routine as well.

March 24, 2020

12 minutes ago, CAD_Noob said:

Thanks! this one worked!

Just need now to manually assign the color.

Don't know if this can be integrated with the routine as well.

example :

(vla-put-color obj AcRed) ; or index 1

updated with progn

Edited March 24, 2020 by hanhphuc

March 24, 2020

1 hour ago, hanhphuc said:

example :

(vla-put-color obj AcRed) ; or index 1

updated with progn

I don't know how to put. i have attached the image.

can it determine the color of the selected object and assign it to a layer?

Say, i select TEST-01 and color red, then TEST-02 its corresponding color...

LEGEND.dwg

Edited March 24, 2020 by CAD_Noob
add sample cad file and image

March 25, 2020

My 1 line defun call (chklay2 lay col lt) with (setq col (acad_colordlg 1)) (setq lt "continuous")

Edited March 25, 2020 by BIGAL

March 25, 2020

Hello,

I've modified my code as per your requirement, I've kept it simpler so that you can understand it step by step.

For assigning colors you can add colors to text directly as shown in below image.

Please try following code in attached:

(defun c:test (/ laycol layer s i o v c)
  (defun laycol	(o)
    (if	(setq
	  o (vla-item (vla-get-layers
			(vla-get-activedocument (vlax-get-acad-object))
		      )
		      (vla-get-layer o)
	    )
	)
      (vla-get-color o)
    )
  )
  (defun layer (name color)
    (entmake (list
	       '(0 . "LAYER")
	       (cons 100 "AcDbSymbolTableRecord")
	       (cons 100 "AcDbLayerTableRecord")
	       (cons 2 name)
	       (cons 70 0)
	       (cons 62 color)
	       (cons 6 "Continuous")
	     )
    )
  )
  (if (setq s (ssget "_:L" '((0 . "*TEXT"))))
    (repeat (setq i (sslength s))
      (setq o (vlax-ename->vla-object (ssname s (setq i (1- i))))
	    v (strcat "A-_" (vla-get-textstring o) "-N")
	    c (vla-get-color o)
      )
      (if (eq c 256)
	(setq c (laycol o))
      )
      (if (not (tblsearch "layer" v))
	(progn
	  (layer v c)
	  (princ (strcat "\nNew layer created : " v))
	)
	(princ (strcat "\nLayer exists : " v))
      )
    )
  )
  (princ)
)

Edited March 25, 2020 by satishrajdev

March 25, 2020

satishrajdev I think the problem is his text is one color so the get-color will return white. Perhaps at start ask add colors or use text color, then could do a if at the (vla-get-color o) or use the (acad_colordlg 1) to pick a colour,you could also (setq c (acad_colordlg (vla-get-color o)) then press ok or change.

March 25, 2020

1 hour ago, satishrajdev said:

Hello,

I've modified my code as per your requirement, I've kept it simpler so that you can understand it step by step.

For assigning colors you can add colors to text directly as shown in below image.

Please try following code in attached:


(defun c:test (/ laycol layer s i o v c)
  (defun laycol	(o)
    (if	(setq
	  o (vla-item (vla-get-layers
			(vla-get-activedocument (vlax-get-acad-object))
		      )
		      (vla-get-layer o)
	    )
	)
      (vla-get-color o)
    )
  )
  (defun layer (name color)
    (entmake (list
	       '(0 . "LAYER")
	       (cons 100 "AcDbSymbolTableRecord")
	       (cons 100 "AcDbLayerTableRecord")
	       (cons 2 name)
	       (cons 70 0)
	       (cons 62 color)
	       (cons 6 "Continuous")
	     )
    )
  )
  (if (setq s (ssget "_:L" '((0 . "*TEXT"))))
    (repeat (setq i (sslength s))
      (setq o (vlax-ename->vla-object (ssname s (setq i (1- i))))
	    v (strcat "A-_" (vla-get-textstring o) "-N")
	    c (vla-get-color o)
      )
      (if (eq c 256)
	(setq c (laycol o))
      )
      (if (not (tblsearch "layer" v))
	(progn
	  (layer v c)
	  (princ (strcat "\nNew layer created : " v))
	)
	(princ (strcat "\nLayer exists : " v))
      )
    )
  )
  (princ)
)

I'm thinking of selecting the text and the polyline beside each text but hey, this is still a great work-around.

Thanks a lot!

March 25, 2020

u can write the name of layer in notepad than run this lsp

make_layer through notepad.lsp

Sign In

Automatic Layer Creation

Recommended Posts

CAD_Noob

BIGAL

CAD_Noob

BIGAL

tombu

satishrajdev

nod684

myloveflyer

BIGAL

CAD_Noob

hanhphuc

CAD_Noob

hanhphuc

CAD_Noob

BIGAL

satishrajdev

BIGAL

CAD_Noob

pmadhwal7

Join the conversation

Tutorials

Forums

Activity