AutoLISP: Control Xref Color

Posted on December 16, 2011 by AutoCAD Tips

http://wp.me/p1aURt-jY

Here is a handy routine that has 4 functions in it. To be honest I don’t know why there are 4 functions – I can understand why 2 of them would be helpful. But it’s always nice to have options…

These routines will control the color of your XREFs. It is sometimes helpful if your entire XREF is a single color so that it is easier to distinguish between your current drawing. Or if you want to have more control over how your XREF looks when it is plotted.

The 4 functions in this routine are:

  • 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

The 2 that I find the most helpful are COLORX and COLORXREF as these either change the entire XREF alone (COLORXREF) or change the entire model – both XREF & current drawing (COLORX).

;;; Posted Vladimir Azarko (VVA)
;;; http://www.cadtutor.net/forum/showthread.php?t=533&page=2
;;;;;;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

About AutoCAD Tips

This blog serves as a knowledge base for myself (and anyone else) so that I can reference tips & tricks that I have learned and also refer others to it as well. I hope that this blog helps you learn at least one tip to make your drafting/design experience better.
This entry was posted in AutoLISP, AutoLISP: Blocks, AutoLISP: Manage, AutoLISP: Modify, Layers, Modifying, TIPS, Uncategorized, XREFs. Bookmark the permalink.

10 Responses to AutoLISP: Control Xref Color

  1. Baber Beg says:
    October 30, 2012 at 2:56 AM

    Brilliant Greg … as I am using ACAD 2009 in the office and the ACAD command XDWGFADECTL is not available in this version.

    This routine helps alot especially when I need to shade the xref a bit so I can see what I am doing.

    Thanks Greg!!!

    Reply
  2. JIM says:
    February 16, 2013 at 1:50 AM

    THE LISP WORK WITH ONLY FEW BLOCKS WHY?

    Reply
  3. Prashant nemade says:
    June 10, 2015 at 1:50 AM

    Really Helpful..thanks…

    Reply
  4. Earlene says:
    September 20, 2015 at 6:59 PM

    The commands are unknown. Why?

    Reply
  5. James C Schumacher says:
    November 12, 2015 at 5:05 AM

    Simply Brilliant!!!! More!!!

    Reply
  6. Michael Vidra says:
    March 1, 2018 at 10:28 AM

    do you have a LISP for changing the color of an individual xref? For example, I want XREF1 to be color 8, and I want XREF2 to be color 3. I do it now through the layer manager and select all layers in the xref then select the color, but if there was a LISP that I could type to than select the xref in MODEL space, then choose a color that would be stupendous!!

    Reply
  7. Ayushi Rai says:
    September 6, 2021 at 11:42 PM

    Where do i get this lisp?

    Reply

Leave a comment