(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