nod684 Posted April 28, 2016 Share Posted April 28, 2016 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. Quote Link to comment Share on other sites More sharing options...
guran Posted April 28, 2016 Share Posted April 28, 2016 You can do that in Layer Properties Manager. Just filter out xref, select all and change whatever you like. Quote Link to comment Share on other sites More sharing options...
bono05 Posted April 28, 2016 Share Posted April 28, 2016 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 Quote Link to comment Share on other sites More sharing options...
rlx Posted April 28, 2016 Share Posted April 28, 2016 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 Quote Link to comment Share on other sites More sharing options...
bono05 Posted April 28, 2016 Share Posted April 28, 2016 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.... Quote Link to comment Share on other sites More sharing options...
rlx Posted April 28, 2016 Share Posted April 28, 2016 bwt , nice lisp / link Bono05 :-) If only our 'administrator' wouldn't have made all our xref's read-only :-( gr. Rlx Quote Link to comment Share on other sites More sharing options...
nod684 Posted April 28, 2016 Author Share Posted April 28, 2016 (edited) 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. Edited April 29, 2016 by nod684 Quote Link to comment Share on other sites More sharing options...
nod684 Posted May 2, 2016 Author Share Posted May 2, 2016 anyone please? Quote Link to comment Share on other sites More sharing options...
Tharwat Posted May 4, 2016 Share Posted May 4, 2016 Hi, If I got your idea of the program well, would changing the layers that belong to Xrefs help? Quote Link to comment Share on other sites More sharing options...
nod684 Posted May 4, 2016 Author Share Posted May 4, 2016 Hi, If I got your idea of the program well, would changing the layers that belong to Xrefs help? yes tharwat...xref layers only. Quote Link to comment Share on other sites More sharing options...
Tharwat Posted May 4, 2016 Share Posted May 4, 2016 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 ? Quote Link to comment Share on other sites More sharing options...
Tharwat Posted May 4, 2016 Share Posted May 4, 2016 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) Quote Link to comment Share on other sites More sharing options...
nod684 Posted May 4, 2016 Author Share Posted May 4, 2016 (edited) 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 Edited May 5, 2016 by nod684 feedback Quote Link to comment Share on other sites More sharing options...
amarcon Posted July 11, 2016 Share Posted July 11, 2016 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 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.