Place object on demo layer

[sakka252]

I want to create a routine that will place selected objects on a the corresponding demo layer.  Here is the outline:

enter command

select object

extract layer name of object (i.e. "CS CURB")

if demo layer exists  (i.e. "CS CURB CD")

>put object on demo layer

>else create demo layer, and place object on layer

It would be nice if I could select multiple objects on different layers.

My questions is, is this possible with lisp? and can someone point me to a good starting point for lisp programing?

Thanks

[_Tharwat]

Here is one way ...

(defun c:test (/ ss i sset)
  (prompt "\n Select object to put on layer [CS CURB CD].. ")
  (if (setq ss (ssget "_:L"))
    (repeat (setq i (sslength ss))
      (setq sset (ssname ss (setq i (1- i))))
      (if (not (tblsearch "LAYER" "CS CURB CD"))
        (entmakex (list '(0 . "LAYER")
                        (cons 100 "AcDbSymbolTableRecord")
                        (cons 100 "AcDbLayerTableRecord")
                        (cons 2 "CS CURB CD")
                        (cons 70 0)
                        (cons 62 1)
                  )
        )
      )
      (entmod (subst (cons 8 "CS CURB CD")
                     (assoc 8 (entget sset))
                     (entget sset)
              )
      )
    )
    (princ "\n Nothing selected ")
  )
  (princ)
)

 Tharwat

[Kent1Cooper]

---

@sakka252 wrote:

I want to create a routine that will place selected objects on a the corresponding demo layer.  Here is the outline:

....

extract layer name of object (i.e. "CS CURB")

if demo layer exists  (i.e. "CS CURB CD")

>put object on demo layer

>else create demo layer, and place object on layer

It would be nice if I could select multiple objects on different layers.

....

---

Here's the way I'd do it [minimally tested]:

(defun C:TDL (/ ss item demolay); = To Demo Layer
  (prompt "\nTo move object(s) to corresponding Demolition Layer(s),")
  (setq ss (ssget))
  (repeat (sslength ss)
    (setq
      item (ssname ss 0); first item in set
      demolay (strcat (cdr (assoc 8 (entget item))) " CD")
    ); end setq
    (if (not (tblsearch "layer" demolay))
      (command "_.layer" "_make" demolay ""); add color, linetype, etc. options...
    ); end if
    (command "_.chprop" item "" "_layer" demolay "")
    (ssdel item ss)
  ); end repeat
); end defun

No CMDECHO off, or other typical controls, yet.

EDIT:

Actually, as I have pointed out often enough here, there's really no need to check whether the Layer exists -- you can just make it, and if it's already there, it won't matter.  That could be reduced to this:

(defun C:TDL (/ ss item); = To Demo Layer
  (prompt "\nTo move object(s) to corresponding Demolition Layer(s),")
  (setq ss (ssget))
  (repeat (sslength ss)
    (setq item (ssname ss 0)); first item in set
    (command

      "_.layer" "_make" (strcat (cdr (assoc 8 (entget item))) " CD") "" ; add color, linetype, etc. options...
      "_.chprop" item "" "_layer" demolay ""

    ); end command
    (ssdel item ss)
  ); end repeat
); end defun

[pbejse]

Another one (similar)

(defun c:mly  (/ objs i ent)
      (setq objs (ssget "_:L" '((8 . "~* CD"))))
      (repeat (setq i (sslength objs))
            (setq ent (entget (ssname objs (setq i (1- i)))))
            
            (entmod (subst (cons 8 (strcat (cdr (assoc 8 ent)) " CD")) (assoc 8 ent) ent))
            )
      (princ)
      )

EDIT: 

I normally would have used tblsearch if i wanted to add color/linetype to the new CD layer.

[Kent1Cooper]

---

@pbejse wrote:

....

(entmod (subst (cons 8 (strcat (cdr (assoc 8 ent)) " CD")) (assoc 8 ent) ent))

....

---

Now that's interesting!  I wouldn't have thought (entmod)/(subst)-ing a Layer into entity data would work if the Demolition Layer name wasn't already in the drawing, but to my great surprise, it creates the Layer in the process!  I'll have to remember that -- I'm sure it will be handy some time.  [However, you'd still need extra steps if you want to assign color(s) or linetype(s) to such Layer(s).]

[pbejse]

However, you'd still need extra steps if you want to assign color(s) or linetype(s) to such Layer(s).]

---

That is correct kent...

[sakka252]

Wow thank you all for your response.

Let's say you wanted the layer to be exactly like the parent layer, but the color was set to 8 (i.e. all demo layers are color 8).  Can you extract the properties of a layer, and assign those properties to a new layer?

[Kent1Cooper · Accepted solution]

---

@sakka252 wrote:

.... 

Let's say you wanted the layer to be exactly like the parent layer, but the color was set to 8 (i.e. all demo layers are color 8).  Can you extract the properties of a layer, and assign those properties to a new layer?

---

For that, because of all the options, it's probably easier to use (subst) and (entmake) to just lengthen the name and assign the color, such as:

(defun C:TDL (/ ss item laydata); = To Demo Layer
  (prompt "\nTo move object(s) to corresponding Demolition Layer(s),")
  (setq ss (ssget))
  (repeat (sslength ss)
    (setq
      item (ssname ss 0); first item in set
      laydata (entget (tblobjname "layer" (cdr (assoc 8 (entget item))))); item's Layer data
      laydata (subst '(62 . 😎 (assoc 62 laydata) laydata); new color
      laydata (subst (cons 2 (strcat (cdr (assoc 2 laydata)) " CD")) (assoc 2 laydata) laydata); longer name
    ); end setq
    (entmake laydata); create the Demolition Layer
    (command "_.chprop" item "" "_layer" (cdr (assoc 2 laydata)) "")
    (ssdel item ss)
  ); end repeat
); end defun

[sakka252]

Thank you. This is exactly what I needed.

Is there a good resources for LISP syntax, i.e. what "laydata" does and what "entmake" does?

[sakka252]

Here is the complete routine

[Kent1Cooper]

---

@sakka252 wrote:

Thank you. This is exactly what I needed.

Is there a good resources for LISP syntax, i.e. what "laydata" does and what "entmake" does?

---

You're welcome.

There's nothing particular about 'laydata' -- it's just a variable name I chose for the current object's LAYer DATA from the Layer definition Table [you could call it anything, within the rules for variable names].  I then re-used the same variable name to replace parts of that data to make a new set of data with which to make a new Layer.  See the AutoLISP Reference in Help for the syntax and arguments and returned values for Lisp functions, including (entmake).

[sakka252]

Oh duh, I realize now it was a variable.

I never knew that LISP sysntax was right there in Help.  Thanks.

[pbejse]

Using Vlisp

includes  Linetype/Color of parent layer and Description

(defun c:mly  (/ aDoc LayCol objs ent CDLayer)
      (vl-load-com)
      (setq aDoc   (vla-get-activedocument (vlax-get-acad-object))
            LayCol (vla-get-layers aDoc))
      (cond ((and
      (ssget "_:L" '((8 . "~* CD")))
      (not
      (vlax-for
             ent  (setq objs (vla-get-activeselectionset aDoc))
            (setq CDLayer
                       (vla-add LayCol (strcat (vla-get-layer ent) " CD")))
            (vla-put-color CDLayer 8)
            (vla-put-linetype
                  CDLayer
                  (vla-get-linetype
                        (vla-item LayCol (vla-get-layer ent))))
            (vla-put-description CDLayer "Demo Layer" )
            (vla-put-layer ent (strcat (vla-get-layer ent) " CD"))
            )
      )
      (vla-delete objs)
      			
      		)
             )
            )
      (princ)
      )

Hope this helps.

[paliitali]

Hi, I was wondering if it is possible to make the lisp routine recognize if the layer ends with E, if it does, create the layer, but switch out the E for D, so if i have a layer G-ANNO-NOTE-E, when selected, the object would be placed on layer G-ANNO-NOTE-D, without deleting or changing the original layer.

Any help would be appreciated.

Thanks

[pbejse]

(defun c:mld  (/ aDoc LayCol objs ent CDLayer nnme)
      (vl-load-com)
      (setq aDoc   (vla-get-activedocument (vlax-get-acad-object))
            LayCol (vla-get-layers aDoc))
      (cond ((and
                   (ssget "_:L" '((8 . "*-E")))
                   (not
                         (vlax-for
                                ent
                                   (setq objs (vla-get-activeselectionset
                                                    aDoc))
                               (setq CDLayer
                                          (vla-add
                                                LayCol
                                                (strcat (setq nnme (vl-string-right-trim
                                                                         "-E"
                                                                         (vla-get-layer ent)))
                                                        "-D")))
                               (vla-put-color CDLayer 2)
                               (vla-put-linetype
                                     CDLayer
                                     (vla-get-linetype
                                           (vla-item
                                                 LayCol
                                                 (vla-get-layer
                                                       ent))))
                               (vla-put-description CDLayer "Demo")
                               (vla-put-layer
                                     ent
                                     (strcat nnme "-D"))
                               )
                         )
                   (vla-delete objs)

                   )
             )
            )
      (princ)
      )

Thew NEW layer will have the color 2 "Yellow"

(vla-put-color CDLayer 2) <-- you can change it here

HTH

[Kent1Cooper]

---

@pbejse wrote:

....

                               (setq CDLayer
                                          (vla-add
                                                LayCol
                                                (strcat (setq nnme (vl-string-right-trim
                                                                         "-E"
                                                                         (vla-get-layer ent)))
                                                        "-D")))
....

---

One part of that is going to cause a problem in the original example:

Command: (vl-string-right-trim "-E" "G-ANNO-NOTE-E")
"G-ANNO-NOT"

Because of the way (vl-string-trim) functions work, it trims off the final E, the hyphen, and the next E.  If you omit the hyphen from the function [with both the E and the D], that part will work as expected:

Command: (vl-string-right-trim "E" "G-ANNO-NOTE-E")
"G-ANNO-NOTE-"

[pbejse]

---

@Kent1Cooper wrote:

---

@pbejse wrote:

....

                               (setq CDLayer
                                          (vla-add
                                                LayCol
                                                (strcat (setq nnme (vl-string-right-trim
                                                                         "-E"
                                                                         (vla-get-layer ent)))
                                                        "-D")))
....

---

One part of that is going to cause a problem in the original example:

Because of the way (vl-string-trim) functions work, it trims off the final E, the hyphen, and the next E. 

If you omit the hyphen from the function [with both the E and the D], that part will work as expected:

Command: (vl-string-right-trim "E" "G-ANNO-NOTE-E")
"G-ANNO-NOTE-"

---

Good catch kent. 🙂

Thank you for your input and for testing the code

Cheers

[paliitali]

Thanks guys, i had been trying to use vl-string-right-trim, but with no luck 🙂

is there there a way to combine the two routines, so if there were two layers, one M-HVAC-SUPP, and another G-ANNO-NOTE-E, if either were selected, a demo layer would be created, M-HVAC-SUPP-D and G-ANNO-NOTE-D

Thanks again

[Kent1Cooper]

---

@xspacex wrote:

.... 

is there there a way to combine the two routines, so if there were two layers, one M-HVAC-SUPP, and another G-ANNO-NOTE-E, if either were selected, a demo layer would be created, M-HVAC-SUPP-D and G-ANNO-NOTE-D

....

---

You could do the Layer creation in several ways, but the question in my mind is what the criteria are for the selected-object Layer(s).  If you really mean specifically those two Layer names only, then [with the Layer name of the object under consideration in a variable called objLayer] you can do something like:
 

(cond

  ((= objLayer "M-HVAC-SUPP") (setq newLayer "M-HVAC-SUPP-D"))

  ((= objLayer "G-ANNO-NOTE-E") (setq newLayer "G-ANNO-NOTE-D"))

)

and have it make a new Layer using the newLayer variable for the name.

Or if you always use those kinds of Layer-name formats, you could make it more generic, so that it will create the appropriate Layer name ending with -D from a given object's Layer name, no matter what that is:

(cond

  ((= (strlen objLayer) 11) (setq newLayer (strcat objLayer "-D"))); add -D to end

  ((= (strlen objLayer) 13) (setq newLayer (strcat (substr objLayer 1 12) "D"))); replace last character with D

)

[paliitali]

I didn't mean those two layers specifically, but just any layer

the problem with the second option, is as you mentioned, the layer format has to always be the same, however, some layers will have 12 characters, and others will have less.

from what was posted here, and from my trial and errors with lisp, i can create a new layer and place a letter where needed. Also, thanks to you guys, i now know how to properly use vl-string-right-trim and am able to create a new layer by removing the E if it exists at the end of a layer. The big question is how do tie these two ideas together.

Thanks