Copy Layer, Add Suffix, Change colour

[blkcar]

Working on a lisp to copy objects layer, add a suffix to existing layer name, changes the colour of the new layer & moves selected object to new layer. Found plenty of lisps found that do 2 of the tasks but not 3.

What I've cobbled together works as intended but I don't know how to bring the linetype across to the new layer.

(defun c:AS (/ esel ent DLname)
  (while (setq esel (entsel "\nPick object to put on its ASCON Layer: "))
    (setq
      ent (car esel)
      DLname (strcat (cdr (assoc 8 (entget ent))) "_ASCON")
    )
    (command
      "_.layer" "_make" DLname "_color" "_truecolor" "255,0,0" "" "_ltype" "" "" ""
      "_.chprop" ent "" "_layer" DLname "" 
    )
  )
  (princ)
)

Any help would be much appreciated.

[paullimapa]

This thread should give you the solution to find the existing layers linetype 

[komondormrex · Accepted solution]

possibly this one

(defun c:AS (/ esel ent DLname ltype)
  (while (setq esel (entsel "\nPick object to put on its ASCON Layer: "))
    (setq
      ent (car esel)
      DLname (strcat (cdr (assoc 8 (entget ent))) "_ASCON")
    )
	(if (null (setq ltype (cdr (assoc 6 (entget ent)))))
		(setq ltype (cdr (assoc 6 (entget (tblobjname "layer" (cdr (assoc 8 (entget ent))))))))
	)
    (command
      "_.layer" "_make" DLname "_color" "_truecolor" "255,0,0" "" "_ltype" ltype "" ""
      "_.chprop" ent "" "_layer" DLname "" 
    )
  )
  (princ)
)

oops

[Kent1Cooper]

If you just make the Layer re-using the entity data of the source Layer but with a changed name, it will carry the linetype along [and lineweight, and plot-or-not, and transparency, and...], so you don't need to spell any of that out for the new Layer.  I leave the color assignment to a Layer command, because I don't think TrueColors are assignable by way of entity data.

(defun c:AS (/ esel ent basename DLname)
  (while (setq esel (entsel "\nPick object to put on its ASCON Layer: "))
    (setq
      ent (car esel)
      basename (cdr (assoc 8 (entget ent)))
    )
    (if (not (wcmatch (strcase basename) "*_ASCON")); not already on such a Layer
      (progn ; then
        (setq DLname (strcat basename "_ASCON"))
        (entmake ;; all properties except changed name
          (append (entget (tblobjname "layer" basename)) (list (cons 2 DLname)))
        )
        (command
          "_.layer" "_color" "_truecolor" "255,0,0" DLname ""
          "_.chprop" ent "" "_layer" DLname "" 
        )
      ); progn
    ); if
  )
  (princ)
)

Consider whether to check that the selected object isn't already on a Layer with that kind of altered name.  If you pick on one that is, you'll end up with a Layer called LayerName_ASCON_ASCON, and so on continually.

EDIT:  I've incorporated that check into the code.

[john.uhden]

@Kent1Cooper wrote "EDIT:  I've incorporated that check into the code."

OMG, @Kent1Cooper checking for potential errors?!

Attaboy, Kent.

[ronjonp]

@Kent1Cooper This will create the new layer with truecolor 'red'.

(entmake ;; all properties except changed name
		 (append (entget (tblobjname "layer" basename))
			 (list (cons 2 dlname) '(62 . 1) '(420 . 16711680))
		 )
	)

[Kent1Cooper]

---

@ronjonp wrote:

This will create the new layer with truecolor 'red'.

....
	(list (cons 2 dlname) '(62 . 1) '(420 . 16711680))
....

---

It makes me wonder why the DXF Reference makes no mention of a 420 entry in its listing for Layer-table data.  And I wonder what relationship 16711680 has to the 255,0,0 RGB TrueColor value.  If one knows the RGB TrueColor value desired, is there any way to determine the appropriate 420-code value, other than to assign the color to a Layer and then look at the Layer's entity data to see what it came up with?

[ronjonp]

@Kent1Cooper Lee has deciphered the voodoo HERE. The math is a bit beyond me.

[blkcar]

Thanks, I was going to add a layer check later after I got it working but you beat me to it.

I was just testing & it was all working well until I tried to copy & paste an object from newly created layer & got this warning.

Command: _copyclip 1 found
*Warning* Multiply owned object, handle "6E"

Won't allow me to copy & paste an object from a newly created layer into a new drawing unless the original source layer also exists in new drawing. Do I need to change the way the layer is created to prevent this error or is it a minor fix to existing code?

Code used is the same, with the addition of the true colour part.

(defun c:AS (/ esel ent basename DLname)
  (while (setq esel (entsel "\nPick object to put on its ASCON Layer: "))
    (setq
      ent (car esel)
      basename (cdr (assoc 8 (entget ent)))
    )
    (if (not (wcmatch (strcase basename) "*_ASCON")); not already on such a Layer
      (progn ; then
        (setq DLname (strcat basename "_ASCON"))
        (entmake ;; all properties except changed name
          (append (entget (tblobjname "layer" basename)) (list (cons 2 dlname) '(62 . 1) '(420 . 16711680)))
        )
        (command
          "_.layer" "_color" "_truecolor" "255,0,0" DLname ""
          "_.chprop" ent "" "_layer" DLname "" 
        )
      ); progn
    ); if
  )
  (princ)
)