AutoLISP: Control Xref Color

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
Advertisements

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.

7 Responses to AutoLISP: Control Xref Color

  1. Baber Beg says:

    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!!!

  2. JIM says:

    THE LISP WORK WITH ONLY FEW BLOCKS WHY?

  3. Prashant nemade says:

    Really Helpful..thanks…

  4. Earlene says:

    The commands are unknown. Why?

  5. Simply Brilliant!!!! More!!!

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s