Jump to content

Automatic Layer Creation


CAD_Noob

Recommended Posts

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

 

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

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
Link to comment
Share on other sites

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
Link to comment
Share on other sites

(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

Link to comment
Share on other sites

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)

Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

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
Link to comment
Share on other sites

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.

 

Link to comment
Share on other sites

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
Link to comment
Share on other sites

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
Link to comment
Share on other sites

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
Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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!

Link to comment
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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

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