Change Xref Color, Linetype an
Hi guys need some help...I'd like to be able to pick an xref, change its color to 8, its line weight to default and its linetype to Hidden to the deepest level if possible.
I will use this to turn all those mechanical equipment and vendors drawing to grey and hidden line. You can do that in Layer Properties Manager. Just filter out xref, select all and change whatever you like. Hi,
I'ts not for me...but i use this one always to put a plan to color 8 (or other)...
Type colorxref...
(defun C:COLORP (/ doc col) (vl-load-com) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark doc) (mip:layer-status-save) (initget 4) (if (setq col (getint "\nEnter color index: ")) (ChangeAllObjectsColor doc col) ;_ col — color number ) ;_ end of if (mip:layer-status-restore) (vla-endundomark doc) (princ)) ;_ end of defun(defun C:COLORXD (/ doc col) (vl-load-com) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark doc) (mip:layer-status-save) (initget 4) (if (setq col (getint "\nEnter color index: ")) (ChangeAllObjectsColor doc col) ;_ col — color number ) ;_ end of if (mip:layer-status-restore) (vla-endundomark doc) (princ)) ;_ end of defun(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-colorindextmpColor) (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-colorindextmpColor) (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 It can depend on the properties of your entities in your xref. Are they color bylayer / byblock etc. Once I took great care for my xrefs, all lines were color and linetype bylayer , all blocks were color byblock etc. Then I worked some years somewhere else and when I returned and saw the shape my xref's were in... boehoehoe...
gr. Rlx Or for this also..."line weight to default and its linetype to Hidden to the deepest level if possible".
Use Edit_bloc from Gilles Chanteau !
http://pagesperso-orange.fr/gile/LISP/Edit_bloc_3.5.zip
But it's in french.... bwt , nice lisp / link Bono05 :-)
If only our 'administrator' wouldn't have made all our xref's read-only :-(
gr. Rlx thanks all for the reply..
i have a lisp that can change the xref to my desired color...
and another one to change its lineweight to default...
for the linetype, I found one but needs DOSlib, unfortunately we are not allowed to installed 3rd party programs...
if possible I'm looking for something that can do all 3 in one shot. anyone please? Hi,
If I got your idea of the program well, would changing the layers that belong to Xrefs help?
yestharwat...xref layers only.
页:
[1]
2