Jump to content

Creating new layers by selecting objects

draik

By draik
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

draik Newbie

draik

Posted
Posted

I need to create layers for new, existing and to be remove objects. For new objects, I will need to create a new layer, adding "_N" to the existing layer names. Same goes for exising "_E" and remove items "_R".

 

This is what I have written.

(defun c:newwork ()
(setq entlist (entget (car (entsel "\nSelect object: "))))
(setvar "clayer" (cdr (assoc 8 entlist)))
(setq layername (getvar "clayer"))
(if (= layername A-_*_**_*)
(command "change" "p" "" "p" "la" newlayername "c" "6" "lt" "bylayer" ""))
(setq newlayername (strcat layername "_N"))
(command "-layer" "m" newlayername "")
(command "change" "p" "" "p" "la" newlayername "c" "6" "lt" "bylayer" "")
)
(defun c:existing ()
(setq abc entlist (entget (car (entsel "\nSelect object: "))))
(setvar "clayer" (cdr (assoc 8 entlist)))
(setq layername (getvar "clayer"))
(setq newlayername (strcat layername "_E"))
(command "-layer" "m" newlayername "")
(command "change" abc "" "p" "la" newlayername "c" "4" "lt" "bylayer" "")
)
(defun c:remove ()
(setq entlist (entget (car (entsel "\nSelect object: "))))
(setvar "clayer" (cdr (assoc 8 entlist)))
(setq layername (getvar "clayer"))
(setq newlayername (strcat layername "_R"))
(command "-layer" "m" newlayername "")
(command "change" "p" "" "p" "la" newlayername "c" "2" "lt" "dashed" "")
)

 

At first, the code seem to work. Then I realise that if I keep changing my mind on whether the item is going to be existing or remove, it will create a lot of layer names. And the layer names can be A-_bldg1234_E-_N_E_R_E_R_E

 

Then I added the "if" code to the newwork comment. Now the codes do not work anymore. Furthermore, the comment do not seems to get the previous selected objects.

 

Can someone help me?

David Bethel Grand Master

David Bethel

Posted
Posted

I think I would lean more towards a single function with a variable action on multiple entities:

 

[b][color=BLACK]([/color][/b]defun c:laysuf [b][color=FUCHSIA]([/color][/b]/ et ss en ed ol oe[b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]initget 1 [color=#2f4f4f]"New Existing Remove"[/color][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq et [b][color=NAVY]([/color][/b]getkword [color=#2f4f4f]"\nChange To - New/Existing/Remove:   "[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq et [b][color=NAVY]([/color][/b]strcase [b][color=MAROON]([/color][/b]strcat [color=#2f4f4f]"_"[/color] [b][color=GREEN]([/color][/b]substr et 1 1[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]and [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]setq en [b][color=GREEN]([/color][/b]ssname ss 0[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]setq ed [b][color=GREEN]([/color][/b]entget en[b][color=GREEN])[/color][/b]
                   ol [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 8 [b][color=RED]([/color][/b]entget en[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                   oe [b][color=GREEN]([/color][/b]if [b][color=BLUE]([/color][/b]> [b][color=RED]([/color][/b]strlen ol[b][color=RED])[/color][/b] 2[b][color=BLUE])[/color][/b]
                          [b][color=BLUE]([/color][/b]substr ol [b][color=RED]([/color][/b]- [b][color=PURPLE]([/color][/b]strlen ol[b][color=PURPLE])[/color][/b] 1[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] ol[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]entmod
               [b][color=GREEN]([/color][/b]subst
                 [b][color=BLUE]([/color][/b]cons 8
                   [b][color=RED]([/color][/b]if [b][color=PURPLE]([/color][/b]member oe '[b][color=TEAL]([/color][/b][color=#2f4f4f]"_E"[/color] [color=#2f4f4f]"_N"[/color] [color=#2f4f4f]"_R"[/color][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b]
                       [b][color=PURPLE]([/color][/b]strcat [b][color=TEAL]([/color][/b]substr ol 1 [b][color=OLIVE]([/color][/b]- [b][color=GRAY]([/color][/b]strlen ol[b][color=GRAY])[/color][/b] 2[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b] et[b][color=PURPLE])[/color][/b]
                       [b][color=PURPLE]([/color][/b]strcat ol et[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                 [b][color=BLUE]([/color][/b]assoc 8 ed[b][color=BLUE])[/color][/b] ed[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]ssdel en ss[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

 

-David

stevesfr Rising Star

stevesfr

Posted
Posted
I think I would lean more towards a single function with a variable action on multiple entities:

 

[b][color=black]([/color][/b]defun c:laysuf [b][color=fuchsia]([/color][/b]/ et ss en ed ol oe[b][color=fuchsia])[/color][/b]

 [b][color=fuchsia]([/color][/b]initget 1 [color=#2f4f4f]"New Existing Remove"[/color][b][color=fuchsia])[/color][/b]
 [b][color=fuchsia]([/color][/b]setq et [b][color=navy]([/color][/b]getkword [color=#2f4f4f]"\nChange To - New/Existing/Remove:   "[/color][b][color=navy])[/color][/b][b][color=fuchsia])[/color][/b]
 [b][color=fuchsia]([/color][/b]setq et [b][color=navy]([/color][/b]strcase [b][color=maroon]([/color][/b]strcat [color=#2f4f4f]"_"[/color] [b][color=green]([/color][/b]substr et 1 1[b][color=green])[/color][/b][b][color=maroon])[/color][/b][b][color=navy])[/color][/b][b][color=fuchsia])[/color][/b]

 [b][color=fuchsia]([/color][/b]and [b][color=navy]([/color][/b]setq ss [b][color=maroon]([/color][/b]ssget[b][color=maroon])[/color][/b][b][color=navy])[/color][/b]
      [b][color=navy]([/color][/b]while [b][color=maroon]([/color][/b]setq en [b][color=green]([/color][/b]ssname ss 0[b][color=green])[/color][/b][b][color=maroon])[/color][/b]
             [b][color=maroon]([/color][/b]setq ed [b][color=green]([/color][/b]entget en[b][color=green])[/color][/b]
                   ol [b][color=green]([/color][/b]cdr [b][color=blue]([/color][/b]assoc 8 [b][color=red]([/color][/b]entget en[b][color=red])[/color][/b][b][color=blue])[/color][/b][b][color=green])[/color][/b]
                   oe [b][color=green]([/color][/b]if [b][color=blue]([/color][/b]> [b][color=red]([/color][/b]strlen ol[b][color=red])[/color][/b] 2[b][color=blue])[/color][/b]
                          [b][color=blue]([/color][/b]substr ol [b][color=red]([/color][/b]- [b][color=purple]([/color][/b]strlen ol[b][color=purple])[/color][/b] 1[b][color=red])[/color][/b][b][color=blue])[/color][/b] ol[b][color=green])[/color][/b][b][color=maroon])[/color][/b]
             [b][color=maroon]([/color][/b]entmod
               [b][color=green]([/color][/b]subst
                 [b][color=blue]([/color][/b]cons 8
                   [b][color=red]([/color][/b]if [b][color=purple]([/color][/b]member oe '[b][color=teal]([/color][/b][color=#2f4f4f]"_E"[/color] [color=#2f4f4f]"_N"[/color] [color=#2f4f4f]"_R"[/color][b][color=teal])[/color][/b][b][color=purple])[/color][/b]
                       [b][color=purple]([/color][/b]strcat [b][color=teal]([/color][/b]substr ol 1 [b][color=olive]([/color][/b]- [b][color=gray]([/color][/b]strlen ol[b][color=gray])[/color][/b] 2[b][color=olive])[/color][/b][b][color=teal])[/color][/b] et[b][color=purple])[/color][/b]
                       [b][color=purple]([/color][/b]strcat ol et[b][color=purple])[/color][/b][b][color=red])[/color][/b][b][color=blue])[/color][/b]
                 [b][color=blue]([/color][/b]assoc 8 ed[b][color=blue])[/color][/b] ed[b][color=green])[/color][/b][b][color=maroon])[/color][/b]
             [b][color=maroon]([/color][/b]ssdel en ss[b][color=maroon])[/color][/b][b][color=navy])[/color][/b][b][color=fuchsia])[/color][/b]
 [b][color=fuchsia]([/color][/b]prin1[b][color=fuchsia])[/color][/b][b][color=black])[/color][/b]

 

-David

 

David: I like it.. on suggestion, would be nice to have the option to retain the color and/or linetype as the original layer ?

just my 2 cents, Steve

pBe Grand Master

pBe

Posted
Posted (edited)

Here's my mediocre attempt

 

 
(defun c:LyrOpt (/ option objs obj obj_e cntr)
(setvar 'Dynmode 1)
(defun chk_me (lyr Typ clr)
       (setq lyr (strcat (vl-string-right-trim "_N_E_R" lyr) typ))
(if  (not (tblsearch "[color=blue]LAYER"[/color] lyr))
               (entmake (list (cons 0 "LAYER")
                (cons 100 "AcDbSymbolTableRecord")
                (cons 100 "AcDbLayerTableRecord")
                (cons 2 lyr)
                (cons 62 clr)          
                (cons 70 0)))
 )
(setq obj_e lyr)
)
(Initget 1 "N E R")
(setq option (getkword "\nEnter Option [New/Existing/Remove]:"))
(setq  objs (ssget) cntr -1)
  (while (setq obj (ssname objs (setq cntr (1+ cntr))))
          (setq obj_e (cdr (assoc 8 (entget obj))))
          (chk_me obj_e (strcat "_" option)
  (cadr (assoc option '(("N" 6)("E" 4)("R" 7)))))
          (vla-put-layer (vlax-ename->vla-object obj) obj_e)
         )
 )

The colors of the layer was based on the OPs request

 

I like Davids code, I never knew you can create a layer on the fly by using

 

(entmod (subst...))

 

Thank you for that David

Nice :D

Edited by pBe
Ooops "BLOCK" to "LAYER"
David Bethel Grand Master

David Bethel

Posted
Posted
David: I like it.. on suggestion, would be nice to have the option to retain the color and/or linetype as the original layer ?

just my 2 cents, Steve

 

 

Maybe like this: 

[b][color=BLACK]([/color][/b]defun c:laysuf [b][color=FUCHSIA]([/color][/b]/ et ss en ed ol oe nl ul td[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]initget 1 [color=#2f4f4f]"New Existing Remove"[/color][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq et [b][color=NAVY]([/color][/b]getkword [color=#2f4f4f]"\nChange To - New/Existing/Remove:   "[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq et [b][color=NAVY]([/color][/b]strcase [b][color=MAROON]([/color][/b]strcat [color=#2f4f4f]"_"[/color] [b][color=GREEN]([/color][/b]substr et 1 1[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]and [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]setq en [b][color=GREEN]([/color][/b]ssname ss 0[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]setq ed [b][color=GREEN]([/color][/b]entget en[b][color=GREEN])[/color][/b]
                   ol [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 8 [b][color=RED]([/color][/b]entget en[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                   td [b][color=GREEN]([/color][/b]tblsearch [color=#2f4f4f]"LAYER"[/color] ol[b][color=GREEN])[/color][/b]
                   oe [b][color=GREEN]([/color][/b]if [b][color=BLUE]([/color][/b]> [b][color=RED]([/color][/b]strlen ol[b][color=RED])[/color][/b] 2[b][color=BLUE])[/color][/b]
                          [b][color=BLUE]([/color][/b]substr ol [b][color=RED]([/color][/b]- [b][color=PURPLE]([/color][/b]strlen ol[b][color=PURPLE])[/color][/b] 1[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] ol[b][color=GREEN])[/color][/b]
                   nl [b][color=GREEN]([/color][/b]if [b][color=BLUE]([/color][/b]member oe '[b][color=RED]([/color][/b][color=#2f4f4f]"_E"[/color] [color=#2f4f4f]"_N"[/color] [color=#2f4f4f]"_R"[/color][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                          [b][color=BLUE]([/color][/b]strcat [b][color=RED]([/color][/b]substr ol 1 [b][color=PURPLE]([/color][/b]- [b][color=TEAL]([/color][/b]strlen ol[b][color=TEAL])[/color][/b] 2[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] et[b][color=BLUE])[/color][/b]
                          [b][color=BLUE]([/color][/b]strcat ol et[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                   ul [b][color=GREEN]([/color][/b]if [b][color=BLUE]([/color][/b]tblsearch [color=#2f4f4f]"LAYER"[/color] nl[b][color=BLUE])[/color][/b] nil T[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]entmod [b][color=GREEN]([/color][/b]subst [b][color=BLUE]([/color][/b]cons 8 nl[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]assoc 8 ed[b][color=BLUE])[/color][/b] ed[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]if ul [b][color=GREEN]([/color][/b]command [color=#2f4f4f]"_.LAYER"[/color]
                             [color=#2f4f4f]"_Color"[/color] [b][color=BLUE]([/color][/b]abs [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 62 td[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] nl
                             [color=#2f4f4f]"_LType"[/color] [b][color=BLUE]([/color][/b]cdr [b][color=RED]([/color][/b]assoc 6 td[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] nl [color=#2f4f4f]""[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]ssdel en ss[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

 

 

-David

stevesfr Rising Star

stevesfr

Posted
Posted

Perfect, thank you David: Steve

pBe Grand Master

pBe

Posted
Posted
.... would be nice to have the option to retain the color and/or linetype as the original layer ?

just my 2 cents, Steve

 

in that case:

 
(defun c:LyrOpt (/ option objs obj obj_e cntr [color=blue]pc[/color])
(setvar 'Dynmode 1)
(defun chk_me (lyr Typ clr ltyp)
       (setq lyr (strcat (vl-string-right-trim "_N_E_R" lyr) typ))
(if  (not (tblsearch "LAYER" lyr))
               (entmake (list (cons 0 "LAYER")
                (cons 100 "AcDbSymbolTableRecord")
                (cons 100 "AcDbLayerTableRecord")
  (cons 2 lyr) 
                   Clr
                  [color=blue]ltyp[/color]
                (cons 70 0)))
 )
(setq obj_e lyr)
)
(Initget 1 "N E R")
(setq option (getkword "\nEnter Option [New/Existing/Remove]:"))
(setq  objs (ssget) cntr -1)
  (while (setq obj (ssname objs (setq cntr (1+ cntr))))
          (setq obj_e (cdr (assoc 8 (entget obj)))
    [color=blue] pc (tblsearch "LAYER" obj_e))[/color]
          (chk_me obj_e (strcat "_" option)[color=blue] (assoc 62 pc)(assoc 6 pc))[/color]
          (vla-put-layer (vlax-ename->vla-object obj) obj_e)
         )
 )

David Bethel Grand Master

David Bethel

Posted
Posted
Perfect, thank you David: Steve

 

Thanks David, you are a life saver.

 

You're both welcome. I would have thought Demo in lieu of Remove but the overall concept of the makes a lot of sense.

 

1 gotcha here would be if you pick a old heavy polyline. You are modifying the header but not stepping through all of the sequential entities. Probably not a biggie. Have fun! -David

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.

×
 Share
Go to topic listing
×
×
  • Create New...