Change Xref Color, Linetype and Lineweight

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

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?

Hi,

 

If I got your idea of the program well, would changing the layers that belong to Xrefs help?

yes tharwat...xref layers only.

yes tharwat...xref layers only.

One more question:

Do you want to change all Xref layers or just layers that related a picked Xref block ?

Anyway, try this program and let me know if this work for you;

(defun c:Test (/ blk doc name lay lname)
 ;;	Tharwat - Date: 04.May.2016	;;
 (if (and (setq blk (car (entsel "\nSelect Xref block :")))
          (vlax-property-available-p (vlax-ename->vla-object blk) 'path)
          (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
                name (cdr (assoc 2 (entget blk))))
          ) 
 (progn
   (if (not (tblsearch "LTYPE" "HIDDEN"))
     (vla-load (vla-get-Linetypes doc) "HIDDEN" "acadiso.lin")
     )      
 (while (setq lay (tblnext "LAYER" (not lay)))
   (if (wcmatch (setq lname (cdr (assoc 2 lay))) (strcat name "|*"))
     (entmod (append (entget (tblobjname "LAYER" lname)) '((62 .  (6 . "HIDDEN") (370 . -3))))
     )
   )
   (vla-regen doc AcAllviewports)
   )
   (alert "Nothing selected or object is not Xref. Block !")
 )
(princ)
)(vl-load-com)

One more question:

Do you want to change all Xref layers or just layers that related a picked Xref block ?

only related picked Xref Block

Anyway, try this program and let me know if this work for you;

 

(defun c:Test (/ blk doc name lay lname)
 ;;    Tharwat - Date: 04.May.2016    ;;
 (if (and (setq blk (car (entsel "\nSelect Xref block :")))
          (vlax-property-available-p (vlax-ename->vla-object blk) 'path)
          (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
                name (cdr (assoc 2 (entget blk))))
          ) 
 (progn
   (if (not (tblsearch "LTYPE" "HIDDEN"))
     (vla-load (vla-get-Linetypes doc) "HIDDEN" "acadiso.lin")
     )      
 (while (setq lay (tblnext "LAYER" (not lay)))
   (if (wcmatch (setq lname (cdr (assoc 2 lay))) (strcat name "|*"))
     (entmod (append (entget (tblobjname "LAYER" lname)) '((62 .  (6 . "HIDDEN") (370 . -3))))
     )
   )
   (vla-regen doc AcAllviewports)
   )
   (alert "Nothing selected or object is not Xref. Block !")
 )
(princ)
)(vl-load-com)

thanks i will try this one out tomorrow and give you feedback

EDIT :

just tested the routine its working fine except that it doesn't change the blocks nested in xrefs

I found this one years ago, and it is quite useful. I make a block of dwg or xref it in....

VVA Post #7 thru to -> #14

http://www.cadtutor.net/forum/showthread.php?533-Lisp-colour-change-for-all-layers-and-blocks&p=208437&viewfull=1#post208437