Creating a new layer with identical properties from an existing object

November 27

I am looking for a Lisp function that can create a new layer by copying all properties from an existing object. I want to duplicate all attributes such as color (index color, true color, color books), line weight, line type, and transparency. The goal is to create an object without assigning it to a layer initially, and then later create a new layer based on this object.

November 28

Let me start by posting this; it's the lego blocks you need to create the layer with the properties you asked for.

If somebody wants to write a function to extract that data from other entities... feel free

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CREATE LAYER with color / also true color


;; transparency.
;; Taken from Steven P, I presume from a Lee Mac function.
;; https://www.cadtutor.net/forum/topic/85796-select-all-layer-turn-to-color-252/#findComment-640849
    (defun LM:setlayertransparency ( lay trn / ent )
      (defun LM:trans->dxf ( x )
        (logior (fix (* 2.55 (- 100 x))) 33554432)
      )
      (if (setq ent (tblobjname "layer" lay))
          (progn
              (regapp "accmtransparency")
              (entmod (append (entget ent) (list
                    (list -3
                      (list "accmtransparency"
                        (cons 1071 (LM:trans->dxf trn))
                      ) ; end list
                    ) ; end list
              ))) ; end entmod
          ) ; end progn
      ) ; end if
    ) ; end defun
	
;; (LM:setlayertransparency Layname (atoi xxx) )	
	
	
;; test, create earth cable layer
(defun c:test_cl ( / )

	(_create_new_layer_ 
		"mynewlayer3" 		;;name 
		'(178 254 1)					;;color  (yellowy green)
		"Center" 						;;ltype 
		1								;;plot
	)
	
	;; set to 70% transparency
	(LM:setlayertransparency "mynewlayer3" 70 )
	
	(_create_new_layer_ 
		"mynewlayer4" 			;;name 
		15						;;color  
		"continuous" 			;;ltype 
		1						;;plot
	)
)

December 2

Okay, I got something.

It copy/pastes:

- color

- linetype

- Transparency

of an object that you select.

And sets those properties to a new layer that you type (getstring).

If there's anything more the script should do, then tell me.

Command: CNLIP (for: Create New Layer Identical Properties)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; https://forum.bricsys.com/discussion/28719/how-to-put-transparency-to-an-objekt-in-bricscad-16
; Transparency:
; 0                              ; Transparency ByLayer.
; (lsh 1 24)         => 16777216 ; Transparency ByBlock.
; (lsh 2 24)         => 33554432 ; Transparency 100%; Saturation   0%.
; (+ (lsh 2 24) 255) => 33554687 ; Transparency   0%; Saturation 100%.

; (_Sys_Transparency_Num_To_Perc 33554661) => 0.1
; (_Sys_Transparency_Num_To_Perc (cdr (assoc 440 (entget (car (entsel))))))
(defun _Sys_Transparency_Num_To_Perc (num)
  (* 0.01 (fix (/ (- 33554687 num) 2.55)))
)

; (_Sys_Transparency_Perc_To_Num 0.1) => 33554661
(defun _Sys_Transparency_Perc_To_Num (perc)
  (fix (- 33554687 (* perc 255)))
)

; (TransparencyPut (car (entsel)) "80")
; (TransparencyPut (car (entsel)) "ByLayer")
; (TransparencyPut (car (entsel)) "ByBlock")
(defun TransparencyPut (enme str)
  (vle-entmod
    440
    enme
    (cond
      ((= "BYLAYER" (strcase str))
        0
      )
      ((= "BYBLOCK" (strcase str))
        16777216
      )
      (T
        (_Sys_Transparency_Perc_To_Num (* 0.01 (atoi str)))
      )
    )
  )
)

; (TransparencyGet (car (entsel)))
(defun TransparencyGet (enme / num)
  ;;(setq num (vle-entget 440 enme))
  (setq num (cdr (assoc 440 (entget enme))))
  
  ;;(princ num)
  
  (cond
    ((not num)
      "BYLAYER"
    )
    ((zerop num)
      "BYLAYER"
    )
    ((= 16777216 num)
      "BYBLOCK"
    )
    (T
      (rtos (* 100 (_Sys_Transparency_Num_To_Perc num)) 2 0)
    )
  )
)

;; Test TransparencyGet
(defun c:gtra ( / )
	(TransparencyGet (car (entsel)))
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(vl-load-com)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; https://www.lee-mac.com/colourconversion.html


;; RGB -> True  -  Lee Mac
;; Args: r,g,b - [int] Red, Green, Blue values

(defun LM:RGB->True ( r g b )
    (logior (lsh (fix r) 16) (lsh (fix g) 8) (fix b))
)

;; True -> RGB  -  Lee Mac
;; Args: c - [int] True Colour

(defun LM:True->RGB ( c )
    (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(8 16 24))
)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CREATE LAYER with color / also true color


;; transparency.
;; Taken from Steven P, I presume from a Lee Mac function.
;; https://www.cadtutor.net/forum/topic/85796-select-all-layer-turn-to-color-252/#findComment-640849
    (defun LM:setlayertransparency ( lay trn / ent )
      (defun LM:trans->dxf ( x )
        (logior (fix (* 2.55 (- 100 x))) 33554432)
      )
      (if (setq ent (tblobjname "layer" lay))
          (progn
              (regapp "accmtransparency")
              (entmod (append (entget ent) (list
                    (list -3
                      (list "accmtransparency"
                        (cons 1071 (LM:trans->dxf trn))
                      ) ; end list
                    ) ; end list
              ))) ; end entmod
          ) ; end progn
      ) ; end if
    ) ; end defun
	
;; (LM:setlayertransparency Layname (atoi xxx) )	
	
	
;; test, create earth cable layer
(defun c:test_cl ( / )

	(_create_new_layer_ 
		"mynewlayer3" 		;;name 
		'(178 254 1)					;;color  (yellowy green)
		"Center" 						;;ltype 
		1								;;plot
	)
	
	;; set to 70% transparency
	(LM:setlayertransparency "mynewlayer3" 70 )
	
	(_create_new_layer_ 
		"mynewlayer4" 			;;name 
		15						;;color  
		"continuous" 			;;ltype 
		1						;;plot
	)
)


(defun _create_new_layer_ (lName color ltype plot / _rgb lt)
  (defun _rgb (l) (+ (lsh (fix (car l)) 16) (lsh (fix (cadr l)) 8) (fix (caddr l))))
  (cond	((not (tblsearch "layer" lName))
	 (entmakex (list '(0 . "LAYER")
			 '(100 . "AcDbSymbolTableRecord")
			 '(100 . "AcDbLayerTableRecord")
			 '(70 . 0)
			 (cons 2 lName)
			 (if color
				 (if (listp color)					;; see if color is a list of RGB
					(cons 420 (_rgb color))		    
					(cons 62 color)
				 )
				 ;; else, default white
				 (cons 62 0)
			 )
			 (cons 6
				(if ltype
					(if (tblsearch "ltype" ltype)
						 ltype
						 "continuous"
					)
					"continuous"
				)
			 )
			 (cons 290 plot)
			 ;;1 = plottable 0 = not=plottable
		   )
	 )
	)
	((tblobjname "layer" lName))
  )
)
;; (_create_new_layer "NewLayerName" '(69 69 69) "3Dash2" 1)			;; true color, some dark grey
;; (_create_new_layer "NewLayerName2" 169 "3Dash2" 1)					;; 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; create a new layer by copying all properties from an existing object. 
;;   such as color (index color, true color, color books), line weight, line type, and transparency. 


;; Create New Layer Identical Properties
(defun c:cnlip ( / src lName color ltype transp)
	
	(setq src (car (entsel "\nSelect source object: ")))
	
	
	(setq  color 
		(if (or  (assoc 420 (entget src))  (assoc 62 (entget src)))
			(if (assoc 420 (entget src))
				(LM:True->RGB  (cdr (assoc 420 (entget src))))
				(cdr (assoc 62 (entget src)))
			)
			;; else ByLayer
			nil
		)
	)
	
	;; Color.  Must return:
	;;  - nil => ByLayer
	;;	- a integer: 0 to 255.  0 = ByBlock; 1=red, 2=yellow, ...
	;;  - RGB list of three 0-255
	(princ "\nColor: ")
	(princ Color)
	;;(princ " - ")
	;;(princ (LM:True->RGB Color))
	
	
	
	(setq ltype 
		(if (assoc 6 (entget src))
			(cdr (assoc 6 (entget src)))
			;; else
			"continuous"
		)	
		
	)
	(princ "\n\Linetype: ")
	(princ ltype)
	
	
	
	
	(setq lName (getstring "\nName of the new layer: "))
	
	(_create_new_layer_ 
		lName 
		color 
		ltype 
		1
	)
	
	;; Transparency
	(setq transp (TransparencyGet src))
	(if (atoi transp)
		(LM:setlayertransparency lName (atoi transp))
	)
	
	(princ "\nLayer created: ")
	(princ lName)
	(princ)
	
)

Edited December 2 by Emmanuel Delay

December 3

On 12/2/2024 at 3:33 PM, Emmanuel Delay said:

Okay, I got something.

It copy/pastes:

- color

- linetype

- Transparency

of an object that you select.

And sets those properties to a new layer that you type (getstring).

If there's anything more the script should do, then tell me.

Command: CNLIP (for: Create New Layer Identical Properties)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; https://forum.bricsys.com/discussion/28719/how-to-put-transparency-to-an-objekt-in-bricscad-16
; Transparency:
; 0                              ; Transparency ByLayer.
; (lsh 1 24)         => 16777216 ; Transparency ByBlock.
; (lsh 2 24)         => 33554432 ; Transparency 100%; Saturation   0%.
; (+ (lsh 2 24) 255) => 33554687 ; Transparency   0%; Saturation 100%.

; (_Sys_Transparency_Num_To_Perc 33554661) => 0.1
; (_Sys_Transparency_Num_To_Perc (cdr (assoc 440 (entget (car (entsel))))))
(defun _Sys_Transparency_Num_To_Perc (num)
  (* 0.01 (fix (/ (- 33554687 num) 2.55)))
)

; (_Sys_Transparency_Perc_To_Num 0.1) => 33554661
(defun _Sys_Transparency_Perc_To_Num (perc)
  (fix (- 33554687 (* perc 255)))
)

; (TransparencyPut (car (entsel)) "80")
; (TransparencyPut (car (entsel)) "ByLayer")
; (TransparencyPut (car (entsel)) "ByBlock")
(defun TransparencyPut (enme str)
  (vle-entmod
    440
    enme
    (cond
      ((= "BYLAYER" (strcase str))
        0
      )
      ((= "BYBLOCK" (strcase str))
        16777216
      )
      (T
        (_Sys_Transparency_Perc_To_Num (* 0.01 (atoi str)))
      )
    )
  )
)

; (TransparencyGet (car (entsel)))
(defun TransparencyGet (enme / num)
  ;;(setq num (vle-entget 440 enme))
  (setq num (cdr (assoc 440 (entget enme))))
  
  ;;(princ num)
  
  (cond
    ((not num)
      "BYLAYER"
    )
    ((zerop num)
      "BYLAYER"
    )
    ((= 16777216 num)
      "BYBLOCK"
    )
    (T
      (rtos (* 100 (_Sys_Transparency_Num_To_Perc num)) 2 0)
    )
  )
)

;; Test TransparencyGet
(defun c:gtra ( / )
	(TransparencyGet (car (entsel)))
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(vl-load-com)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; https://www.lee-mac.com/colourconversion.html


;; RGB -> True  -  Lee Mac
;; Args: r,g,b - [int] Red, Green, Blue values

(defun LM:RGB->True ( r g b )
    (logior (lsh (fix r) 16) (lsh (fix g) 8) (fix b))
)

;; True -> RGB  -  Lee Mac
;; Args: c - [int] True Colour

(defun LM:True->RGB ( c )
    (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(8 16 24))
)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CREATE LAYER with color / also true color


;; transparency.
;; Taken from Steven P, I presume from a Lee Mac function.
;; https://www.cadtutor.net/forum/topic/85796-select-all-layer-turn-to-color-252/#findComment-640849
    (defun LM:setlayertransparency ( lay trn / ent )
      (defun LM:trans->dxf ( x )
        (logior (fix (* 2.55 (- 100 x))) 33554432)
      )
      (if (setq ent (tblobjname "layer" lay))
          (progn
              (regapp "accmtransparency")
              (entmod (append (entget ent) (list
                    (list -3
                      (list "accmtransparency"
                        (cons 1071 (LM:trans->dxf trn))
                      ) ; end list
                    ) ; end list
              ))) ; end entmod
          ) ; end progn
      ) ; end if
    ) ; end defun
	
;; (LM:setlayertransparency Layname (atoi xxx) )	
	
	
;; test, create earth cable layer
(defun c:test_cl ( / )

	(_create_new_layer_ 
		"mynewlayer3" 		;;name 
		'(178 254 1)					;;color  (yellowy green)
		"Center" 						;;ltype 
		1								;;plot
	)
	
	;; set to 70% transparency
	(LM:setlayertransparency "mynewlayer3" 70 )
	
	(_create_new_layer_ 
		"mynewlayer4" 			;;name 
		15						;;color  
		"continuous" 			;;ltype 
		1						;;plot
	)
)


(defun _create_new_layer_ (lName color ltype plot / _rgb lt)
  (defun _rgb (l) (+ (lsh (fix (car l)) 16) (lsh (fix (cadr l)) 8) (fix (caddr l))))
  (cond	((not (tblsearch "layer" lName))
	 (entmakex (list '(0 . "LAYER")
			 '(100 . "AcDbSymbolTableRecord")
			 '(100 . "AcDbLayerTableRecord")
			 '(70 . 0)
			 (cons 2 lName)
			 (if color
				 (if (listp color)					;; see if color is a list of RGB
					(cons 420 (_rgb color))		    
					(cons 62 color)
				 )
				 ;; else, default white
				 (cons 62 0)
			 )
			 (cons 6
				(if ltype
					(if (tblsearch "ltype" ltype)
						 ltype
						 "continuous"
					)
					"continuous"
				)
			 )
			 (cons 290 plot)
			 ;;1 = plottable 0 = not=plottable
		   )
	 )
	)
	((tblobjname "layer" lName))
  )
)
;; (_create_new_layer "NewLayerName" '(69 69 69) "3Dash2" 1)			;; true color, some dark grey
;; (_create_new_layer "NewLayerName2" 169 "3Dash2" 1)					;; 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; create a new layer by copying all properties from an existing object. 
;;   such as color (index color, true color, color books), line weight, line type, and transparency. 


;; Create New Layer Identical Properties
(defun c:cnlip ( / src lName color ltype transp)
	
	(setq src (car (entsel "\nSelect source object: ")))
	
	
	(setq  color 
		(if (or  (assoc 420 (entget src))  (assoc 62 (entget src)))
			(if (assoc 420 (entget src))
				(LM:True->RGB  (cdr (assoc 420 (entget src))))
				(cdr (assoc 62 (entget src)))
			)
			;; else ByLayer
			nil
		)
	)
	
	;; Color.  Must return:
	;;  - nil => ByLayer
	;;	- a integer: 0 to 255.  0 = ByBlock; 1=red, 2=yellow, ...
	;;  - RGB list of three 0-255
	(princ "\nColor: ")
	(princ Color)
	;;(princ " - ")
	;;(princ (LM:True->RGB Color))
	
	
	
	(setq ltype 
		(if (assoc 6 (entget src))
			(cdr (assoc 6 (entget src)))
			;; else
			"continuous"
		)	
		
	)
	(princ "\n\Linetype: ")
	(princ ltype)
	
	
	
	
	(setq lName (getstring "\nName of the new layer: "))
	
	(_create_new_layer_ 
		lName 
		color 
		ltype 
		1
	)
	
	;; Transparency
	(setq transp (TransparencyGet src))
	(if (atoi transp)
		(LM:setlayertransparency lName (atoi transp))
	)
	
	(princ "\nLayer created: ")
	(princ lName)
	(princ)
	
)

You're a lifesaver! Thank you so much for creating this. It's been a long time coming. Hit me up if you're ever in Thailand, I owe you a coffee. I'm sure this will be a big help to many.

December 3

On 12/2/2024 at 3:33 PM, Emmanuel Delay said:

Okay, I got something.

It copy/pastes:

- color

- linetype

- Transparency

of an object that you select.

And sets those properties to a new layer that you type (getstring).

If there's anything more the script should do, then tell me.

Command: CNLIP (for: Create New Layer Identical Properties)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; https://forum.bricsys.com/discussion/28719/how-to-put-transparency-to-an-objekt-in-bricscad-16
; Transparency:
; 0                              ; Transparency ByLayer.
; (lsh 1 24)         => 16777216 ; Transparency ByBlock.
; (lsh 2 24)         => 33554432 ; Transparency 100%; Saturation   0%.
; (+ (lsh 2 24) 255) => 33554687 ; Transparency   0%; Saturation 100%.

; (_Sys_Transparency_Num_To_Perc 33554661) => 0.1
; (_Sys_Transparency_Num_To_Perc (cdr (assoc 440 (entget (car (entsel))))))
(defun _Sys_Transparency_Num_To_Perc (num)
  (* 0.01 (fix (/ (- 33554687 num) 2.55)))
)

; (_Sys_Transparency_Perc_To_Num 0.1) => 33554661
(defun _Sys_Transparency_Perc_To_Num (perc)
  (fix (- 33554687 (* perc 255)))
)

; (TransparencyPut (car (entsel)) "80")
; (TransparencyPut (car (entsel)) "ByLayer")
; (TransparencyPut (car (entsel)) "ByBlock")
(defun TransparencyPut (enme str)
  (vle-entmod
    440
    enme
    (cond
      ((= "BYLAYER" (strcase str))
        0
      )
      ((= "BYBLOCK" (strcase str))
        16777216
      )
      (T
        (_Sys_Transparency_Perc_To_Num (* 0.01 (atoi str)))
      )
    )
  )
)

; (TransparencyGet (car (entsel)))
(defun TransparencyGet (enme / num)
  ;;(setq num (vle-entget 440 enme))
  (setq num (cdr (assoc 440 (entget enme))))
  
  ;;(princ num)
  
  (cond
    ((not num)
      "BYLAYER"
    )
    ((zerop num)
      "BYLAYER"
    )
    ((= 16777216 num)
      "BYBLOCK"
    )
    (T
      (rtos (* 100 (_Sys_Transparency_Num_To_Perc num)) 2 0)
    )
  )
)

;; Test TransparencyGet
(defun c:gtra ( / )
	(TransparencyGet (car (entsel)))
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(vl-load-com)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; https://www.lee-mac.com/colourconversion.html


;; RGB -> True  -  Lee Mac
;; Args: r,g,b - [int] Red, Green, Blue values

(defun LM:RGB->True ( r g b )
    (logior (lsh (fix r) 16) (lsh (fix g) 8) (fix b))
)

;; True -> RGB  -  Lee Mac
;; Args: c - [int] True Colour

(defun LM:True->RGB ( c )
    (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(8 16 24))
)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CREATE LAYER with color / also true color


;; transparency.
;; Taken from Steven P, I presume from a Lee Mac function.
;; https://www.cadtutor.net/forum/topic/85796-select-all-layer-turn-to-color-252/#findComment-640849
    (defun LM:setlayertransparency ( lay trn / ent )
      (defun LM:trans->dxf ( x )
        (logior (fix (* 2.55 (- 100 x))) 33554432)
      )
      (if (setq ent (tblobjname "layer" lay))
          (progn
              (regapp "accmtransparency")
              (entmod (append (entget ent) (list
                    (list -3
                      (list "accmtransparency"
                        (cons 1071 (LM:trans->dxf trn))
                      ) ; end list
                    ) ; end list
              ))) ; end entmod
          ) ; end progn
      ) ; end if
    ) ; end defun
	
;; (LM:setlayertransparency Layname (atoi xxx) )	
	
	
;; test, create earth cable layer
(defun c:test_cl ( / )

	(_create_new_layer_ 
		"mynewlayer3" 		;;name 
		'(178 254 1)					;;color  (yellowy green)
		"Center" 						;;ltype 
		1								;;plot
	)
	
	;; set to 70% transparency
	(LM:setlayertransparency "mynewlayer3" 70 )
	
	(_create_new_layer_ 
		"mynewlayer4" 			;;name 
		15						;;color  
		"continuous" 			;;ltype 
		1						;;plot
	)
)


(defun _create_new_layer_ (lName color ltype plot / _rgb lt)
  (defun _rgb (l) (+ (lsh (fix (car l)) 16) (lsh (fix (cadr l)) 8) (fix (caddr l))))
  (cond	((not (tblsearch "layer" lName))
	 (entmakex (list '(0 . "LAYER")
			 '(100 . "AcDbSymbolTableRecord")
			 '(100 . "AcDbLayerTableRecord")
			 '(70 . 0)
			 (cons 2 lName)
			 (if color
				 (if (listp color)					;; see if color is a list of RGB
					(cons 420 (_rgb color))		    
					(cons 62 color)
				 )
				 ;; else, default white
				 (cons 62 0)
			 )
			 (cons 6
				(if ltype
					(if (tblsearch "ltype" ltype)
						 ltype
						 "continuous"
					)
					"continuous"
				)
			 )
			 (cons 290 plot)
			 ;;1 = plottable 0 = not=plottable
		   )
	 )
	)
	((tblobjname "layer" lName))
  )
)
;; (_create_new_layer "NewLayerName" '(69 69 69) "3Dash2" 1)			;; true color, some dark grey
;; (_create_new_layer "NewLayerName2" 169 "3Dash2" 1)					;; 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; create a new layer by copying all properties from an existing object. 
;;   such as color (index color, true color, color books), line weight, line type, and transparency. 


;; Create New Layer Identical Properties
(defun c:cnlip ( / src lName color ltype transp)
	
	(setq src (car (entsel "\nSelect source object: ")))
	
	
	(setq  color 
		(if (or  (assoc 420 (entget src))  (assoc 62 (entget src)))
			(if (assoc 420 (entget src))
				(LM:True->RGB  (cdr (assoc 420 (entget src))))
				(cdr (assoc 62 (entget src)))
			)
			;; else ByLayer
			nil
		)
	)
	
	;; Color.  Must return:
	;;  - nil => ByLayer
	;;	- a integer: 0 to 255.  0 = ByBlock; 1=red, 2=yellow, ...
	;;  - RGB list of three 0-255
	(princ "\nColor: ")
	(princ Color)
	;;(princ " - ")
	;;(princ (LM:True->RGB Color))
	
	
	
	(setq ltype 
		(if (assoc 6 (entget src))
			(cdr (assoc 6 (entget src)))
			;; else
			"continuous"
		)	
		
	)
	(princ "\n\Linetype: ")
	(princ ltype)
	
	
	
	
	(setq lName (getstring "\nName of the new layer: "))
	
	(_create_new_layer_ 
		lName 
		color 
		ltype 
		1
	)
	
	;; Transparency
	(setq transp (TransparencyGet src))
	(if (atoi transp)
		(LM:setlayertransparency lName (atoi transp))
	)
	
	(princ "\nLayer created: ")
	(princ lName)
	(princ)
	
)

(defun c:foo ( / a n)
(princ "\nSelect Objects to change ")
(setq a (ssget))
(setq n (getstring "\n Enter name of new layer "))
(vl-cmdf "._layer" "_n" n "")
(vl-cmdf "._change" a "" "_p" "_la" n "")
(princ)
)

I found this code, it only creates a layer and then converts an object into that created layer. Could you please integrate it with your code that you created?

December 4

At the end of my code:

Insert this line of code.

This puts the object you first selected in the newly created layer.

	(princ "\nLayer created: ")
	(princ lName)
	
	;; put the selected object in the newly created layer
	(vla-put-layer (vlax-ename->vla-object src) lName )
	
	(princ)
)

... Or do you want to select a bunch of other objects to be put in that new layer?

in that case, at the end of the code:

	(princ "\nLayer created: ")
	(princ lName)
	
	(princ "\nOptionally, select a bunch of objects to be put in the new layer: ")
	(setq i 0)
	(setq ss (ssget))
	(if ss
		(repeat (sslength ss)
			(vla-put-layer (vlax-ename->vla-object (ssname ss i)) lName )
			(setq i (+ i 1))
		)
	)
	(princ)
	
)

December 9

On 12/4/2024 at 3:13 PM, Emmanuel Delay said:
At the end of my code:

Insert this line of code.

This puts the object you first selected in the newly created layer.
	(princ "\nLayer created: ")
	(princ lName)
	
	;; put the selected object in the newly created layer
	(vla-put-layer (vlax-ename->vla-object src) lName )
	
	(princ)
)
... Or do you want to select a bunch of other objects to be put in that new layer?

in that case, at the end of the code:
	(princ "\nLayer created: ")
	(princ lName)
	
	(princ "\nOptionally, select a bunch of objects to be put in the new layer: ")
	(setq i 0)
	(setq ss (ssget))
	(if ss
		(repeat (sslength ss)
			(vla-put-layer (vlax-ename->vla-object (ssname ss i)) lName )
			(setq i (+ i 1))
		)
	)
	(princ)
	
)

Thank you very much. It works really well.

Sign In

Creating a new layer with identical properties from an existing object

Recommended Posts

pondpepo9

Emmanuel Delay

Emmanuel Delay

pondpepo9

pondpepo9

Emmanuel Delay

pondpepo9

Join the conversation

Tutorials

Forums

Activity