Lisp to change all element to "0" layer and white color but not linetype

[senthil.barani]

Hi,

I am looking for a lisp to change all elements in the drawing to "0" layer and white color but linetype to be retained as it is. Please anyone help me in this regard?

Thanks in advance.

[dlanorh]

Does this include entities inside blocks?

[senthil.barani]

No need to change entities in the blocks.

[dbhunia]

without Block......try this.......

(defun c:All2L0 ( / SS blname acdoc props Blk_Lst blname_nested Ch_MLed_Col Ch_Obj_Lay)
	(vl-load-com)
	(defun Ch_MLed_Col ( obj / llc)
		(setq llc (vla-get-LeaderLineColor obj))
		(vla-put-ColorIndex llc "7")
		(vla-put-LeaderLineColor obj llc)
		(Ch_Obj_Lay obj)
	)
	(defun Ch_Obj_Lay ( obj / Obj_Ltype layers)
		(setq layers (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object))))
		(if (= nil (setq Obj_Ltype (cdr(assoc 6 (entget (vlax-vla-object->ename obj))))))
			(setq Obj_Ltype (vla-get-Linetype (vla-item layers (vlax-get-property obj 'Layer))))
		)
		(vlax-put-property obj 'Layer "0")
		(vlax-put-property obj 'Linetype Obj_Ltype)
	)
	(if (setq ss (ssget "_X"))
		(progn 
			(vla-StartUndoMark (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))))
			(setvar 'cmdecho 0)
			(setq props '(Color DimensionLineColor ExtensionLineColor LeaderLineColor LeaderColor TextColor))
			(foreach Ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
				(foreach prop props (vl-catch-all-apply 'vlax-put-property (list (vlax-ename->vla-object Ent) prop "7")))
				(vl-catch-all-apply 'vla-put-color (list (vlax-ename->vla-object Ent) "7"))
				(Ch_Obj_Lay (vlax-ename->vla-object Ent))
				(if (wcmatch (vla-get-ObjectName (vlax-ename->vla-object Ent)) "*MLeader") 
					(Ch_MLed_Col (vlax-ename->vla-object Ent))
				)
			)
			(setvar 'cmdecho 1)
			(vla-EndUndoMark acdoc)
		)
	)
	(princ)
)

with nested block ....... try this.......

(defun c:All2L0 ( / SS blname acdoc props Blk_Lst blname_nested Ch_MLed_Col Ch_Obj_Lay Uni Chp_Blk)
	(vl-load-com)
	(defun Ch_MLed_Col ( obj / llc)
		(setq llc (vla-get-LeaderLineColor obj))
		(vla-put-ColorIndex llc "7")
		(vla-put-LeaderLineColor obj llc)
		(Ch_Obj_Lay obj)
	)
	(defun Ch_Obj_Lay ( obj / Obj_Ltype layers)
		(setq layers (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object))))
		(if (= nil (setq Obj_Ltype (cdr(assoc 6 (entget (vlax-vla-object->ename obj))))))
			(setq Obj_Ltype (vla-get-Linetype (vla-item layers (vlax-get-property obj 'Layer))))
		)
		(vlax-put-property obj 'Layer "0")
		(vlax-put-property obj 'Linetype Obj_Ltype)
	)
	(defun Uni (lst) (if lst (cons (car lst) (Uni (vl-remove (car lst) (cdr lst))))))
	(defun Chp_Blk ( blk_name / blname_nested Obj_Ltype)
		(setq Blk_Lst (cons blk_name Blk_Lst))
		(vlax-for obj (vla-item (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk_name)
			(if (= "AcDbBlockReference" (vla-get-objectname obj))
				(if (not (member (setq name_nest (vla-get-Effectivename obj)) blname_nested))
					(setq blname_nested (cons (vla-get-Effectivename obj) blname_nested))
				)
			)
			(foreach prop props 
				(vl-catch-all-apply 'vlax-put-property (list obj prop "7"))
				(Ch_Obj_Lay obj)
			)
			(if (wcmatch (vla-get-ObjectName obj) "*MLeader") (Ch_MLed_Col obj))
			(vl-catch-all-apply 'vla-put-color (list obj "7"))
			(Ch_Obj_Lay obj)
		)
		(foreach name_nested blname_nested (CHP_BLK name_nested))
	)	
	(if (setq ss (ssget "_X"))
		(progn 
			(vla-StartUndoMark (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))))
			(setvar 'cmdecho 0)
			(setq props '(Color DimensionLineColor ExtensionLineColor LeaderLineColor LeaderColor TextColor))
			(foreach Ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
				(if (and (= "AcDbBlockReference" (vla-get-objectname (vlax-ename->vla-object Ent)))
						 (not (member (setq blname (vla-get-Effectivename (vlax-ename->vla-object Ent))) Blk_Lst))
					)
					(CHP_BLK blname)
				)
				(foreach prop props (vl-catch-all-apply 'vlax-put-property (list (vlax-ename->vla-object Ent) prop "7")))
				(vl-catch-all-apply 'vla-put-color (list (vlax-ename->vla-object Ent) "7"))
				(Ch_Obj_Lay (vlax-ename->vla-object Ent))
				(if (wcmatch (vla-get-ObjectName (vlax-ename->vla-object Ent)) "*MLeader") 
					(Ch_MLed_Col (vlax-ename->vla-object Ent))
				)
			)
			(foreach Blk (setq Blk_Lst (Uni Blk_Lst))(command-s "_.bedit" Blk)(vla-zoomextents (vlax-get-acad-object))(command-s "_.bclose" "_s"))
			(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acAllViewports)
			(setvar 'cmdecho 1)
			(vla-EndUndoMark acdoc)
		)
	)
	(princ)
)

[senthil.barani]

Thank you very much. I got exactly i wanted.

[2022ht30224]

;;;;;;ColorX - change color all object of drawing. All layer unlock and thaw
;;;;;;ColorXREF change color xref only on a current session. All layer unlock and thaw
;;;;;;ColorXL - change color all object of drawing. Objects on the locked and frozen layers are ignored
;;;;;;ColorXREFL change color xref only on a current session. Objects on the locked and frozen layers are ignored
(defun C:COLORX (/ doc col)
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(mip:layer-status-save)
(if (setq col (acad_colordlg 7 t))
(ChangeAllObjectsColor doc col) ;_ col — color number
) ;_ end of if
(mip:layer-status-restore)
(vla-endundomark doc)
(princ)
) ;_ end of defun
(defun C:COLORXREF (/ doc col)
(vl-load-com)
(alert
"\This lisp change color xref\nONLY ON A CURRENT SESSION"
) ;_ end of alert
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(mip:layer-status-save)
(if (setq col (acad_colordlg 7 t))
(ChangeXrefAllObjectsColor doc col) ;_ col — color number
) ;_ end of if
(mip:layer-status-restore)
(vla-endundomark doc)
(princ)
) ;_ end of defun
(defun C:COLORXL (/ doc col)
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(if (setq col (acad_colordlg 7 t))
(ChangeAllObjectsColor doc col) ;_ col — color number
) ;_ end of if
(vla-endundomark doc)
(princ)
) ;_ end of defun
(defun C:COLORXREFL (/ doc col)
(vl-load-com)
(alert
"\This lisp change color xref\nONLY ON A CURRENT SESSION"
) ;_ end of alert
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(if (setq col (acad_colordlg 7 t))
(ChangeXrefAllObjectsColor doc col) ;_ col — color number
) ;_ end of if
(vla-endundomark doc)
(princ)
) ;_ end of defun
(defun mip:layer-status-restore ()
(foreach item *MIP_LAYER_LST*
(if (not (vlax-erased-p (car item)))
(vl-catch-all-apply
'(lambda ()
(vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
(vla-put-freeze
(car item)
(cdr (assoc "freeze" (cdr item)))
) ;_ end of vla-put-freeze
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of if
) ;_ end of foreach
(setq *MIP_LAYER_LST* nil)
) ;_ end of defun
(defun mip:layer-status-save ()
(setq *MIP_LAYER_LST* nil)
(vlax-for item (vla-get-layers
(vla-get-activedocument (vlax-get-acad-object))
) ;_ end of vla-get-layers
(setq *MIP_LAYER_LST*
(cons (list item
(cons "freeze" (vla-get-freeze item))
(cons "lock" (vla-get-lock item))
) ;_ end of cons
*MIP_LAYER_LST*
) ;_ end of cons
) ;_ end of setq
(vla-put-lock item :vlax-false)
(if (= (vla-get-freeze item) :vlax-true)
(vl-catch-all-apply
'(lambda () (vla-put-freeze item :vlax-false))
) ;_ end of vl-catch-all-apply
) ;_ end of if
) ;_ end of vlax-for
) ;_ end of defun
(defun ChangeXrefAllObjectsColor (Doc Color / tmp txtstr)
(vlax-for Blk (vla-get-Blocks Doc)
(cond
((or (= (vla-get-IsXref Blk) :vlax-true)
(and (= (vla-get-IsXref Blk) :vlax-false)
(wcmatch (vla-get-name Blk) "*|*")
) ;_ end of and
) ;_ end of or
(vlax-for Obj Blk
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'Color)
) ;_ end of and
(vla-put-Color Obj Color)
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'TextString)
) ;_ end of and
(progn
(setq txtstr
(if (vlax-method-applicable-p Obj 'FieldCode)
(vla-FieldCode Obj)
(vlax-get-property Obj 'TextString))
)
(setq tmp 0)
(while (setq tmp (VL-STRING-SEARCH "\\C" txtstr tmp))
(setq txtstr
(vl-string-subst
(strcat (substr txtstr (1+ tmp) 2)(itoa Color) ";")
(substr txtstr (1+ tmp) (- (1+ (VL-STRING-SEARCH ";" txtstr tmp)) tmp))
txtstr
tmp)
)
(setq tmp (+ tmp 3))
)
(vla-put-Textstring Obj txtstr)
)
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(= (vla-get-ObjectName obj) "AcDbBlockReference")
(= (vla-get-HasAttributes obj) :vlax-true)
) ;_ end of and
(foreach att (vlax-safearray->list
(vlax-variant-value (vla-GetAttributes obj))
) ;_ end of vlax-safearray->list
(if (and (vlax-write-enabled-p att)
(vlax-property-available-p att 'Color)
) ;_ end of and
(vla-put-Color att Color)
) ;_ end of if
) ;_ end of foreach
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(wcmatch (vla-get-Objectname Obj) "*Dimension*,AcDb*Leader")
) ;_ end of and
(progn
(vl-catch-all-apply 'vla-put-ExtensionLineColor (list Obj Color))
(vl-catch-all-apply 'vla-put-TextColor (list Obj Color))
(vl-catch-all-apply 'vla-put-DimensionLineColor (list Obj Color))
(if (vlax-property-available-p Obj 'LeaderLineColor)
(progn
(setq tmp (vla-getinterfaceobject(vlax-get-acad-object)(strcat "AutoCAD.AcCmColor."
(substr (getvar "ACADVER") 1 2))))
(vla-put-colorindex tmp Color)
(vl-catch-all-apply 'vla-put-LeaderLineColor (list Obj tmp))
)
)
) ;_ end of progn
) ;_ end of if
) ;_ end of vlax-for
)
((= (vla-get-IsLayout Blk) :vlax-true)
(vlax-for Obj Blk
(if
(and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'Color)
(vlax-property-available-p Obj 'Path)
(wcmatch (strcase (vla-get-ObjectName Obj)) "*BLOCK*")
) ;_ end of and
(vla-put-Color Obj Color)
) ;_ end of if
) ;_ end of vlax-for
)
(t nil)
) ;_cond
) ;_ end of vlax-for
(vl-cmdf "_redrawall")
) ;_ end of defun
(defun ChangeAllObjectsColor (Doc Color / txtstr tmp txt count)
(vlax-for Blk (vla-get-Blocks Doc)
(if (= (vla-get-IsXref Blk) :vlax-false)
(progn
(setq count 0 txt (strcat "Changed " (vla-get-name Blk)))
(grtext -1 txt)
(vlax-for Obj Blk
(setq count (1+ count))
(if (zerop(rem count 10))(grtext -1 (strcat txt " : " (itoa count))))
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'Color)
) ;_ end of and
(vla-put-Color Obj Color)
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'TextString)
) ;_ end of and
(progn
(setq txtstr
(if (vlax-method-applicable-p Obj 'FieldCode)
(vla-FieldCode Obj)
(vlax-get-property Obj 'TextString))
)
(setq tmp 0)
(while (setq tmp (VL-STRING-SEARCH "\\C" txtstr tmp))
(setq txtstr
(vl-string-subst
(strcat (substr txtstr (1+ tmp) 2)(itoa Color) ";")
(substr txtstr (1+ tmp) (- (1+ (VL-STRING-SEARCH ";" txtstr tmp)) tmp))
txtstr
tmp)
)
(setq tmp (+ tmp 3))
)
(vla-put-Textstring Obj txtstr)
)
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(= (vla-get-ObjectName obj) "AcDbBlockReference")
(= (vla-get-HasAttributes obj) :vlax-true)
) ;_ end of and
(foreach att (vlax-safearray->list
(vlax-variant-value (vla-GetAttributes obj))
) ;_ end of vlax-safearray->list
(if (and (vlax-write-enabled-p att)
(vlax-property-available-p att 'Color)
) ;_ end of and
(vla-put-Color att Color)
) ;_ end of if
) ;_ end of foreach
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(wcmatch (vla-get-Objectname Obj) "*Dimension*,AcDb*Leader")
) ;_ end of and
(progn
(vl-catch-all-apply 'vla-put-ExtensionLineColor (list Obj Color))
(vl-catch-all-apply 'vla-put-TextColor (list Obj Color))
(vl-catch-all-apply 'vla-put-DimensionLineColor (list Obj Color))
(if (vlax-property-available-p Obj 'LeaderLineColor)
(progn
(setq tmp (vla-getinterfaceobject(vlax-get-acad-object)(strcat "AutoCAD.AcCmColor."
(substr (getvar "ACADVER") 1 2))))
(vla-put-colorindex tmp Color)
(vl-catch-all-apply 'vla-put-LeaderLineColor (list Obj tmp))
)
)
) ;_ end of progn
) ;_ end of if
) ;_ end of vlax-for
)
) ;_ end of if
) ;_ end of vlax-for
(vl-cmdf "_redrawall")
) ;_ end of defun
(princ
"\nType ColorX, COLORXREF, ColorXL, COLORXREFL in command line"
) ;_ end of princ

Sir, in the above lisp code, can you please rewrite the colorX command to change all the objects in the drawing except white (index color 7 or 255,255,255) color lines. with the above command everything is changing to the given color. please add exception of white color.
thankyou much appreciated.