Jump to content
CAD_Noob

Automatic Layer Creation

Recommended Posts

CAD_Noob

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

 

Share this post


Link to post
Share on other sites
BIGAL

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.

Share this post


Link to post
Share on other sites
CAD_Noob

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

 

Share this post


Link to post
Share on other sites
BIGAL

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

Share this post


Link to post
Share on other sites
tombu

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

 

Share this post


Link to post
Share on other sites
satishrajdev
Posted (edited)

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 by satishrajdev

Share this post


Link to post
Share on other sites
nod684
Posted (edited)
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 by nod684

Share this post


Link to post
Share on other sites
myloveflyer
(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

Share this post


Link to post
Share on other sites
BIGAL

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)

Share this post


Link to post
Share on other sites
CAD_Noob
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...

 

Share this post


Link to post
Share on other sites
hanhphuc
Posted (edited)
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 by hanhphuc
release object, vla-put-color
  • Thanks 1

Share this post


Link to post
Share on other sites
CAD_Noob
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.

 

Share this post


Link to post
Share on other sites
hanhphuc
Posted (edited)
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 by hanhphuc
  • Like 1

Share this post


Link to post
Share on other sites
CAD_Noob
Posted (edited)
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.JPG

LEGEND.dwg

Edited by CAD_Noob
add sample cad file and image

Share this post


Link to post
Share on other sites
BIGAL
Posted (edited)

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

 

image.png.d8966697981d2a6fcfc8e866b16583ee.png

Edited by BIGAL

Share this post


Link to post
Share on other sites
satishrajdev
Posted (edited)

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.

image.png.a979fbc639508d6c3c9c85abb98bf3d4.png

 

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 by satishrajdev
  • Like 1

Share this post


Link to post
Share on other sites
BIGAL

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.

Share this post


Link to post
Share on other sites
CAD_Noob
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.

image.png.a979fbc639508d6c3c9c85abb98bf3d4.png

 

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!

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...