Lisp colour change for all layers and blocks

[hyposmurf]

When we receive drawings from architects,we then only change the colour of thier layers so that ours stand out more.As we use colour dependant plot styles the best colour for architectual xrefs is colour 8.Sometimes we have blocks that are on the wrong layer and the only way to modify them is by using the modify in place xref command,individually altering the clour properties of each one.There an alternative method,to by just exploding them all but thats my last resort.Does anyone know of a lisp that will change all the layers of a drawing to one colour and that will also do this for all blocks to.Heres me hoping :)
I just found a lisp for it but doesnt seem to work,wont recognise the lisp?
; Changes the color of every entity in a drawing
; to BYLAYER, and changes all Layer colors to what
; you specify.

;(defun c:RICH ( / e d edata bdef bent ecl color)
(graphscr)
(setq ecl '(62 . 256))
(setvar "CMDECHO" 0)
(command "_.Layer" "unlock" "*" "")
(princ "\nModify Main Entities...")
(setq e (entnext))
(while e
(entmod (list (cons -1 e) ecl))
(setq e (entnext e))
)
(princ "\nModifying Block Entities... ")
(while (setq bdef (tblnext "block" (not bdef)))
(setq bent (cdr (assoc -2 bdef)))
(while bent
(entmod (list (cons -1 bent) ecl))
(setq bent (entnext bent))
)
)
(princ "\nRegenerating drawing... ")
(command "_.regenall")
(princ)

(COMMAND "AUDIT" "Y" )
(COMMAND "AUDIT" "Y" )
(PRINC)
Whats up,any ideas? :?

[fuccaro]

I just learned in this Forum (here http://www.cadtutor.net/forum/viewtopic.php?t=504) to try the simple solutions first.
Hyposmurf
Is it too hard to select all objects in your DWG and use CHPROP to change they color to 8? Or use the properties window if you think it is more convenient.
Also in the "Layer properties manager" window you may select all the layers by pressing CTRL+A and modify they color from a snap.
Probable it is possible to write a Lisp for. But CADTutor will post a trick with a right-click or something and all the Forum will laugh on me :)

[hyposmurf]

I found another way to :D .Ive tried changing the colours by the properties and also from within the layers properties manager,but I still end up having to modify blocks that are not "by layer".A way around this is to use a lisp called "burst" that explodes the blocks and then converts the attributes to text(usually if you explode blocks you end with just attribute tags,which is not good).Still dont like the idea of exploding drawings but it seems to work fine,for this purpose,as the xref is then bound to form a block later on anyway.One thing that I used to always notice when people first start out using CAD is if theyre not sure how to modify any attributes they would just explode the block or drawing,which is really your last option.For such things as titleblocks this can be a messy way of doing things

[kumbaya]

In newer CAD (2008 for sure) there's SETBYLAYER command which can be usful in changing all objects' properities to 'BY LAYER' (blocks, too)....

[brawleyman]

In newer CAD (2008 for sure) there's SETBYLAYER command which can be usful in changing all objects' properities to 'BY LAYER' (blocks, too)....


Yes! Awsome! I have needing something like this for a while! In my work, we take architectural plans and make everything color 8 so that the floor plans are in the background and our electrical shows up on top better.

Thanks kumbaya!

This could be helpful for anyone else needing to know, so this will act as a bump for it. :D

[Lee Mac]

In newer CAD (2008 for sure) there's SETBYLAYER command which can be usful in changing all objects' properities to 'BY LAYER' (blocks, too)....

You learn something new everyday!

Thanks Kumbaya - very handy when using newer CAD versions :)

[VVA]

Type ColorX in command line


(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 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)))
(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 vlax-for
) ;_ end of defun
(defun ChangeAllObjectsColor (Doc Color )
(vlax-for Blk (vla-get-Blocks Doc)
(if (= (vla-get-IsXref Blk) :vlax-false)
(vlax-for Obj Blk
(if (vlax-property-available-p Obj 'Color)
(vla-put-Color Obj Color)
)
)
)
)
)
(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
)
(mip:layer-status-restore)
(vla-endundomark doc)
(princ)
)
(princ "\nType ColorX in command line")

[Hunter]

Thanks , VVA
It's really a wonderful lisp~

[ichlove]

This lisp can chnage the xref color which are in the block ,but is there any way can change the xref color which is not in block( not set by layer)? Is there anyone can help? tks


Type ColorX in command line


(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 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)))
(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 vlax-for
) ;_ end of defun
(defun ChangeAllObjectsColor (Doc Color )
(vlax-for Blk (vla-get-Blocks Doc)
(if (= (vla-get-IsXref Blk) :vlax-false)
(vlax-for Obj Blk
(if (vlax-property-available-p Obj 'Color)
(vla-put-Color Obj Color)
)
)
)
)
)
(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
)
(mip:layer-status-restore)
(vla-endundomark doc)
(princ)
)
(princ "\nType ColorX in command line")

[VVA]

This Lisp does not change xref. If you want to change xref, open it and use ColorX.

[ichlove]

This Lisp does not change xref. If you want to change xref, open it and use ColorX.
Sorry,VVA,I didn't get it.Maybe I misunderstood,but I already used ColorX which the lisp you posted before.But it still didn't change the overwrited color on the drawing which have xref(not the source drawing)
Looking forward your reply
thanks

[VVA]

Probably we do not understand each other. Can be variable VISRETAIN will help for xref layer color?
And it is even better to publish a small example of that does not do ColorX

[ichlove]

Sorry for the confusing.Let me try to make it clear.What we want to achieve is when we make a new drawing base on a reference drawing(probably get from other company),and we want the reference drawing are all turn into be grey,so our drawing can be very clear.But unfortunately,we only can change the color which are bylayer,if the object color is not set bylayer propotion,it's won't change.

Attached pls find the small souring drawing (for test )& sample effect

Following are the test steps:
1.open a blanket drawing,then use xref command to attach the source drawing,
2.change the xref color in layer manager.choose grey
3.run the colorx command,you will find still some object not change the color yet.


And it would be better the lisp won't change the color of the current drawing,because right now ,when you run colorx,it will also affect the current drawing's block.we hope can chose the refernce drawing first then run the command.


BTW,visretain doesn't work,we tried.

Hope it's clear enough.

Thanks in advance

[VVA]

Command:
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
*** Add 20.03.2009 - Now ColorX ColorXREF work with Attrubutes
*** Add 31.03.2009 - Now ColorX and ColorXREF colored dimension (include radius).
*** Add 02.04.2009 - Change color Qleader, Mtext, Mleader. Add Simple progressbar

Other command links

BLCC - Changes color of the chosen blocks
ENCC - Changes color of the chosen objects (may be element of the block) (http://www.cadtutor.net/forum/showpost.php?p=291428&postcount=63)
ColorA - Changes in the color of selected items in the area (http://www.cadtutor.net/forum/showthread.php?533-Lisp-colour-change-for-all-layers-and-blocks&p=335976&viewfull=1#post335976)
COLORXLAY - changes xref layer colors (http://www.cadtutor.net/forum/showthread.php?533-Lisp-colour-change-for-all-layers-and-blocks&p=278058&viewfull=1#post278058)
COLORFL - Color From Layer (http://www.cadtutor.net/forum/showthread.php?533-Lisp-colour-change-for-all-layers-and-blocks&p=285235&viewfull=1#post285235)
PFL - Properties From Layer (http://www.cadtutor.net/forum/showthread.php?533-Lisp-colour-change-for-all-layers-and-blocks&p=286035&viewfull=1#post286035)
Attcol - Attribute Color (http://www.cadtutor.net/forum/showthread.php?533-Lisp-colour-change-for-all-layers-and-blocks&p=292530&viewfull=1#post292530)

If you want to operate colour of xref objects in the blanket drawing:
1. Open Xref (sourcing drawing.dwg)
2. Run ColorX and set color bylayer
3.open a blanket drawing
4. Creat layer "Xref"
5. Set layer "Xref" current
6 use xref command to attach the source drawing (sourcing drawing.dwg)
7.change the xref color in layer manager. choose grey
NOTE. If some objects in xref (sourcing drawing.dwg) are placed on a layer 0 your mast change layer of an insert of the external reference in a blanket drawing to grey too. (layer "XREF")
I do not know as this technical term sounds in English. I translate from Russian: there Is an emersion of a layer 0. All objects located on 0 layer in drawing of the external reference (sourcing drawing.dwg) inherit properties of a external reference layer in blanket drawing (layer "XREF")

[ichlove]

Thanks a lot!VVA,that's excellent,problem been sloved!!
One more small request,when I run colorxref now,it will effect all the xref color.What if I want to lock one layer color,don't be affect by colorxref.Is that possible?

Thanks again!

[Came]

Thanks for this

one more thing is added to my repertoire :shock:

guys this is so old 6 years , when we're going to celebrate brithday

[VVA]

One more small request,when I run colorxref now,it will effect all the xref color.What if I want to lock one layer color,don't be affect by colorxref.Is that possible?
Adds some commands in #14 (http://www.cadtutor.net/forum/showpost.php?p=221559&postcount=14)

[ichlove]

Hi VVA,
Really thanks for the xref color lisp.It works very well.:)

Can you also help me to slove the another problem about the draworder,see the info here.
http://www.cadtutor.net/forum/showthread.php?p=222871#post222871

Tks

[ichlove]

Hi VVa ,
Sorry, we meet a new problem today,when we bind the current drawing with source drawing,the source drawing(grey one)will lost.Can you help us to slove this problem?
tks

Adds some commands in #14 (http://www.cadtutor.net/forum/showpost.php?p=221559&postcount=14)

[VVA]

I bind grey source drawing and all ok.
1. What color of your Model tab background?
2. If to use CTRL+A that something is selected?
PS.
From my practice.
Colour of model Model tab background set to True color 0,0,0.
Insert xref by black colour. Xref on model tab it is not visible, but it was selected on CTR+A.

[ichlove]

Hi VVA,
1.Our Model background was black,but when I tried white or grey,it still doesn't work,no source drawing.
2.Because sth conflict with our customise system,our CTRL + A command is disable,so normally we just use mouse to select all.I tried mouse,still nothing happened.what I gonna do?

thanks

I bind grey source drawing and all ok.
1. What color of your Model tab background?
2. If to use CTRL+A that something is selected?
PS.
From my practice.
Colour of model Model tab background set to True color 0,0,0.
Insert xref by black colour. Xref on model tab it is not visible, but it was selected on CTR+A.

[VVA]

2.Because sth conflict with our customise system,our CTRL + A command is disable,so normally we just use mouse to select all.I tried mouse,still nothing happened.what I gonna do?
Copy or type this in command line

(SSSETFIRST nil (ssget "_ALL"))

Variant 2:
Type in command line _PSELECT and then _all

[ichlove]

Tried select all,but still nothing happended:(

Attached is test drawing I use,maybe will help.

Thanks

[VVA]

1. I change code in #14 (http://www.cadtutor.net/forum/showpost.php?p=221559&postcount=14). Now Color?? commands work whith Attributes (I hope :))
2. I run _AUDIT command in your file


Command: _audit

Fix any errors detected? [Yes/No] <N>: Y

Auditing Header


DXF Name Current Value Validation Default
AcDbSortentsTable(1493)
Error for Entry (69F62,69FA2) eDuplicateKey fixed
AcDbSortentsTable(1493)
Error for Entry (69F72,6A0B0) eDuplicateKey fixed
AcDbSortentsTable(1493)
Error for Entry (69FB2,69F92) eDuplicateKey fixed
AcDbSortentsTable(1493)
Error for Entry (69FD2,69FC2) eDuplicateKey fixed

88 Blocks audited
Pass 1 199 objects audited
Pass 2 199 objects audited
Pass 3 4800 objects audited
Total errors found 4 fixed 4

2. Insert test.dwg as xref. Type ClorXREF and select 252 color. Bind your test.dwg without problem.

[ichlove]

Hi VVA,
I have been tried your method,still doesn't work on my test drawing,I don't know why:(.Command line will show "Regenerating model"(see the attachment).Would mind post a smal video or screen shot about how you bind the drawing?By the way, the color of attribute has been changed,thanks a lot!

[VVA]

I have found the decision of this problem. Similar, it is bug AutoCAD.
In version 2006 all is normal.
In versions 2008 and 2009 similar problems are observed.
For bind of the xref use a command _CLASSICXREF and its option bind

[ichlove]

Sorry,I tried the command & bind option,will show this.The strange thing is,when I don't change the xref color,the drawing can be bind.By the way,which cad version you use?

I think I found the problem,as long as there is dimension ,the drawing will lost.but I don't konw how to slove it

[VVA]

Yes, at me too such messages. Then try to change algorithm.
Open a file test.dwg, run ColorX and change colour to 252 and then insert as xref.

[ichlove]

Hi,VVA,thanks for the solution.
This can slove the problem,but not the best way.Because we don't want to change anything from the source drawing.

BTW,when I use colorxref,all the color can be changed,except the dimension one,maybe lisp code can help with that.

Thanks a lot:)

Yes, at me too such messages. Then try to change algorithm.
Open a file test.dwg, run ClorX and change colour to 252 and then insert as xref.

[VVA]

BTW,when I use colorxref,all the color can be changed,except the dimension one,maybe lisp code can help with that.
Edit lisp in #14 (http://www.cadtutor.net/forum/showpost.php?p=221559&postcount=14) Now it colored dimension

[Jorg Janssen]

Command:
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
*** Add 20.03.2009
Now ColorX ColorXREF work with Attrubutes
*** Add 30.03.2009
Now ColorXREF and ColorXREFL colored dimension.


(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)
(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)
(= (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*")
) ;_ end of and
(progn
(vl-catch-all-apply
'(lambda ()
(vla-put-ExtensionLineColor Obj Col)
(vla-put-TextColor Obj Col)
(vla-put-DimensionLineColor Obj Col)
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ 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
) ;_ end of defun
(defun ChangeAllObjectsColor (Doc Color)
(vlax-for Blk (vla-get-Blocks Doc)
(if (= (vla-get-IsXref Blk) :vlax-false)
(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)
(= (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
) ;_ end of vlax-for
) ;_ end of if
) ;_ end of vlax-for
) ;_ 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
(princ
"\nType ColorX, COLORXREF, ColorXL, COLORXREFL in command line"
) ;_ end of princ

If you want to operate colour of xref objects in the blanket drawing:
1. Open Xref (sourcing drawing.dwg)
2. Run ColorX and set color bylayer
3.open a blanket drawing
4. Creat layer "Xref"
5. Set layer "Xref" current
6 use xref command to attach the source drawing (sourcing drawing.dwg)
7.change the xref color in layer manager. choose grey
NOTE. If some objects in xref (sourcing drawing.dwg) are placed on a layer 0 your mast change layer of an insert of the external reference in a blanket drawing to grey too. (layer "XREF")
I do not know as this technical term sounds in English. I translate from Russian: there Is an emersion of a layer 0. All objects located on 0 layer in drawing of the external reference (sourcing drawing.dwg) inherit properties of a external reference layer in blanket drawing (layer "XREF")

Thanks for this fine lisp, there's just one thing in my drawing which won't get another color and that are the radius dimensions. Maybe there's also a solution for this?

[VVA]

Try code from #14 (http://www.cadtutor.net/forum/showpost.php?p=221559&postcount=14)

[haustab]

nice.
but i miss (q)leader



(and (eq (vla-get-objectname ent) "AcDbLeader")
(vla-put-DIMENSIONLINECOLOR ent col)
)

and mtext with more then one color
something like


(setq txtstr (vlax-get-property vlaobj 'TextString))
(setq txtstr (vl-string-subst XOLDCOLOR XNEWCOLOR txtstr))

[VVA]

nice.
but i miss (q)leader



(and (eq (vla-get-objectname ent) "AcDbLeader")
(vla-put-DIMENSIONLINECOLOR ent col)
)

and mtext with more then one color
something like


(setq txtstr (vlax-get-property vlaobj 'TextString))
(setq txtstr (vl-string-subst XOLDCOLOR XNEWCOLOR txtstr))
Thanks. Try #14 (http://www.cadtutor.net/forum/showpost.php?p=221559&postcount=14) now. Add Mleader too.

[haustab]

hallo,

vla-put-LeaderLineColor is not supported on 2007!?
(or have a other leader :()
(0 . "LEADER")..(100 . "AcDbLeader")

ObjectName (RO) = "AcDbLeader"

[VVA]

I little edit #14.

hallo,
vla-put-LeaderLineColor is not supported on 2007!?
(or have a other leader :()
(0 . "LEADER")..(100 . "AcDbLeader")
ObjectName (RO) = "AcDbLeader"
I use catch
(vl-catch-all-apply 'vla-put-LeaderLineColor (list Obj tmp))

[haustab]

Sorry,
in 2007 it do not works,
error VLA-PUT-LEADERLINECOLOR
in the help of vlide and with vlax-dump-Object, there is no property available, no LEADERLINECOLOR
perheps you use 2008 and it is new in 2008
but

(and (eq (vla-get-objectname ent) "AcDbLeader")
(vla-put-DIMENSIONLINECOLOR ent col)
) this works o:)

and the colors in mtext...

[VVA]

Has added property check LeaderLineColor
Look #14
LeaderLineColor - property of object AcDbMLeader. New in Acad 2008.

[haustab]

nice. very nice
:thumbsup:

[Tommy78]

This script is nearly what i need, but not just yet :).
In my department (electricity) when we make layout plans, we make the architectural xref grey by changing the layer colours (manually) so the electrical components are more visible on the plot.
This lisp by vva changes the color of the objects but not the layers and is only temporarily, the xref is in full color when reloaded after a save.
Is there a script that changes xref layer colors?
thanks!

[VVA]

...
Is there a script that changes xref layer colors?
thanks!
Try it. Change xref layer colors


(defun C:COLORXLAY (/ doc col)
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(if (setq col (acad_colordlg 7 nil))
(vlax-for item (vla-get-Layers doc)
(if (wcmatch (vla-get-name item) "*|*")
(vla-put-color item col)
)
)
) ;_ end of if
(vla-endundomark doc)
(princ)
) ;_ end of d

[Tommy78]

Thanks VVA, that works quite good!
Would it be hard to add an option to select which xref you want to change? :oops:

If you can manage that i will stop begging. :P

[VVA]

New variant (much longer than the previous :))


(defun C:COLORXLAY (/ doc col xreflist ret)
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for item (vla-get-Blocks doc)
(if (= (vla-get-IsXref item) :vlax-true)
(setq xreflist (cons (vla-get-name item) xreflist))
)
)
(if xreflist
(if (and (setq ret (_dwgru-get-user-dcl "Select XREF " (acad_strlsort xreflist) t))
(setq col (acad_colordlg 7 nil))
)
(progn
(setq ret (apply 'strcat (mapcar '(lambda(x)(strcat x "|*,")) ret)))
(vla-startundomark doc)
(vlax-for item (vla-get-Layers doc)
(if (wcmatch (vla-get-name item) ret)
(vla-put-color item col)
)
)
(vla-endundomark doc)
)
) ;_ end of if
(alert "No XREF Found")
)
(princ)
) ;_ end of defun

;;; ************************************************** **********************
;;; * Library DWGruLispLib Copyright © 2008 DWGru Programmers Group
;;; *
;;; * _dwgru-get-user-dcl (Candidate)
;;; *
;;; * Inquiry of value at the user through a dialogue window
;;; *
;;; *
;;; * 26/01/2008 Version 0002. Edition Vladimir Azarko (VVA)
;;; - the Output on double a clique if the plural choice (multi-nil) is forbidden
;;; - Processing of several columns
;;; * 21/01/2008 Version 0001. Edition Vladimir Azarko (VVA)
(defun _DWGRU-GET-USER-DCL (ZAGL INFO-LIST MULTI
/ FL RET
DCL_ID MAXROW MAX_COUNT_COL
COUNT_COL I LISTBOX_HEIGHT
LST _LOC_FINISH _LOC_CLEAR
NCOL
)
;|
* Inquiry of value at the user through a dialogue window
* Dialogue is formed to "strike"
* the Quantity of lines on page without scrolling is set by variable MAXROW.
* It is necessary to remember, that number MAXROW increases on 3.
* the Maximum quantity of columns is set by variable MAX_COUNT_COL
* It is published
http://dwg.ru/f/showthread.php?p=203746#post203746
* Parameters of a call:
zagl - heading of a window [String]
info-list - the list of line values [List of String]
multi - t - the plural choice is resolved, nil-is not present

* Returns:
The list of the chosen lines or nil - a cancelling
* the Example
(_dwgru-get-user-dcl " Specify a variant " ' ("First" "Second" "Third") nil); _-> ("First")
(_dwgru-get-user-dcl " Specify a variant " ' ("First" "Second" "Third") t); _-> ("First" "Second ")
(_dwgru-get-user-dcl " Specify a variant "
(progn (setq i 0 lst nil) (repeat 205 (setq lst (cons (strcat "Value-" (itoa (setq i (1 + i)))) lst))) (reverse lst)) nil)
(_dwgru-get-user-dcl " Specify a variant, using CTRL and SHIFT for a choice "
(progn (setq i 0 lst nil) (repeat 205 (setq lst (cons (strcat "Value-" (itoa (setq i (1 + i)))) lst))) (reverse lst)) t)
|;
(setq MAXROW 40) ;_ max lines without scrolling (To it 3 more lines further will be added)
(setq MAX_COUNT_COL 5) ; _ a maximum quantity of columns
;;============== Local functions START========================

(defun _LOC_FINISH ()
(setq I 0
RET NIL
) ;_ end ofsetq
(repeat COUNT_COL
(setq I (1+ I))
(setq RET (cons (cons I (get_tile (strcat "info" (itoa I)))) RET))
) ;_ end ofrepeat
(setq RET (reverse RET))
(done_dialog 1)
) ;_ end ofdefun
(defun _LOC_CLEAR (NOMER)
(setq I 0)
(repeat COUNT_COL
(setq I (1+ I))
(if (/= I NOMER)
(progn
(start_list (strcat "info" (itoa I)))
(mapcar 'add_list (nth (1- I) LST))
(end_list)
) ;_ end ofprogn
) ;_ end ofif
) ;_ end ofrepeat
) ;_ end ofdefun

;;;==================== Local functions END ==================================
;;;==================== MAIN PART ===============================================
(if (null ZAGL)(setq ZAGL "Select")) ;_ end if
(if (zerop (rem (length INFO-LIST) MAXROW))
(setq COUNT_COL (/ (length INFO-LIST) MAXROW))
(setq COUNT_COL (1+ (fix (/ (length INFO-LIST) MAXROW 1.0))))
) ;_ end ofif
(if (> COUNT_COL MAX_COUNT_COL)
(setq COUNT_COL MAX_COUNT_COL)
)
(setq LISTBOX_HEIGHT (+ 3 MAXROW))
;_ We add 3 lines for appearance and for exception boundary scroll
(if (and (= COUNT_COL 1) (<= (length INFO-LIST) MAXROW))
(setq LISTBOX_HEIGHT (+ 3 (length INFO-LIST)))
) ;_ end ofif
(setq I 0)
(setq FL (vl-filename-mktemp "dwgru" NIL ".dcl"))
(setq RET (open FL "w")
LST NIL
) ;_ end ofsetq
(mapcar '(lambda (X) (write-line X RET))
(append (list "dwgru_get_user : dialog { "
(strcat "label=\"" ZAGL "\";")
": boxed_row {"
"label = \"Value\";"
) ;_ end oflist
(repeat COUNT_COL
(setq LST
(append
LST
(list
" :list_box {"
"alignment=top ;"
(if MULTI
"multiple_select = true ;"
"multiple_select = false ;"
) ;_ end ofif
"width=31 ;"
(strcat "height= " (itoa LISTBOX_HEIGHT) " ;")
"is_tab_stop = false ;"
(strcat "key = \"info" (itoa (setq I (1+ I))) "\";}")
) ;_ end oflist
) ;_ end ofappend
) ;_ end ofsetq
) ;_ end ofrepeat
(list
"}"
":row{"
"ok_cancel_err;}}"
) ;_ end oflist
) ;_ end of list
) ;_ end of mapcar
(setq RET (close RET))
(if (and (null (minusp (setq DCL_ID (load_dialog FL))))
(new_dialog "dwgru_get_user" DCL_ID)
) ;_ end and
(progn
(setq LST INFO-LIST)
((lambda (/ RET1 BUF ITM)

(repeat (1- COUNT_COL)
(setq I '-1)
(while (and (setq ITM (car LST))
(< (setq I (1+ I)) MAXROW)
) ;_ end of and
(setq BUF (cons ITM BUF)
LST (cdr LST)
) ;_ end of setq
) ;_ end ofwhile
(setq RET1 (cons (reverse BUF) RET1)
BUF NIL
) ;_ end of setq
) ;_ end of repeat
(setq RET RET1)
) ;_ end of lambda
)
(if LST
(setq RET (cons LST RET))
) ;_ end ofif
(setq LST (reverse RET))
(setq I 0)
(mapcar '(lambda (THIS_LIST)
(if (<= (setq I (1+ I)) COUNT_COL)
(progn
(start_list (strcat "info" (itoa I)))
(mapcar 'add_list THIS_LIST)
(end_list)
) ;_ end ofprogn
) ;_ end ofif
) ;_ end oflambda
LST
) ;_ end ofmapcar

(set_tile "info1" "0")
(setq I 0
NCOL 1
) ;_ end ofsetq
(repeat COUNT_COL
(action_tile
(strcat "info" (itoa (setq I (1+ I))))
(strcat "(progn (setq Ncol "
(itoa I)
")(if (not multi)(_loc_clear Ncol))"
"(if (and (not multi)(= $reason 4))(_loc_finish)))"
) ;_ end ofstrcat
) ;_ end ofaction_tile
) ;_ end ofrepeat
(action_tile "cancel" "(done_dialog 0)")
(action_tile "accept" "(_loc_finish)")
(if MULTI
(set_tile "error" "Use CTRL and SHIFT for a choicet") ;_ end ofset_tile
(set_tile "error" "It is possible to choose double click") ;_ end ofset_tile
) ;_ end ofif
(if (zerop (start_dialog))
(setq RET NIL)
(progn
(setq
RET (apply
'append
(mapcar
'(lambda (ITM)
(setq THIS_LIST (nth (1- (car ITM)) LST))
(mapcar
(function (lambda (NUM) (nth NUM THIS_LIST)))
(read (strcat "(" (cdr ITM) ")"))
) ;_ end ofmapcar
) ;_ end oflambda
RET
) ;_ end ofmapcar
) ;_ end ofapply
) ;_ end ofsetq

) ;_ end ofprogn
) ;_ end if
(unload_dialog DCL_ID)
) ;_ end of progn
) ;_ end of if
(vl-file-delete FL)
RET
) ;_ end ofdefun

[Tommy78]

WOW! :?

Thank you so much VVA, this is exactly what we need here, unfortunately nobody here knows how to write lisps :).
If i can do something for you let me know, hint: i'm quite good with dynamic blocks.

спасибо !!

[Tommy78]

OK VVA, 1 more request and i will stop bothering you, really!... maybe :)
I tried to find it myself looking at the code of the colorx lisp, but it's a bit like chinese for me.

I need to be able to exclude colors 250,251,252,253,254 and 255 from the layer selection or maybe exclude locked layers if that's simpler.

I looked at the code and i think this:

(setq ret (apply 'strcat (mapcar '(lambda(x)(strcat x "|*,")) ret)))

is the line for layer selection, is that right?

[VVA]

Right. keep the new version. The main highlighted in red. Need a function _dwgru-get-user-dcl of the previous (#43) post


(defun C:COLORXLAY1 (/ doc col xreflist ret ignorecolor)
(vl-load-com)
(setq ignorecolor '(250 251 252 253 254 255))
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for item (vla-get-Blocks doc)
(if (= (vla-get-IsXref item) :vlax-true)
(setq xreflist (cons (vla-get-name item) xreflist))
)
)
(if xreflist ;;; If exist XREF
(if (and ;;;get xref name and color
(setq ret (_dwgru-get-user-dcl "Select XREF " (acad_strlsort xreflist) t))
(setq col (acad_colordlg 7 nil))
)
(progn
(setq ret (apply 'strcat (mapcar '(lambda(x)(strcat x "|*,")) ret)))
(vla-startundomark doc)
(vlax-for item (vla-get-Layers doc)
(if (and (wcmatch (vla-get-name item) ret) ;;; same mask xref
(not(member(vla-get-color item) ignorecolor))
)
(vla-put-color item col)
)
)
(vla-endundomark doc)
)
) ;_ end of if
(alert "No XREF Found")
)
(princ)
) ;_ end of defun

[Tommy78]

Yes! it works great, thanks again VVA

[leone]

thanks for color

[flopo]

This Lisp does not change xref. If you want to change xref, open it and use ColorX.




Hello VVA,
I saw your lisp that change the colour of object. Do you have any idea about a lisp for keeping the same colour of objects ? At first the objects have a colour by layer, and after moving them in another layer have the same colour, but this time not by layer. I mean, if i move an object from layer 1, where this object has "by layer" colour (red, let's say) in layer 2, the object will have also red colour, but this time the colour will not be defined "by layer". Thanks!

[VVA]

Specify clearly the object of the same color, which has a layer on which it is located


(defun C:COLORFL ( / adoc blocks color ent lays)
;;;Color From Layer
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
lays (vla-get-layers adoc)
)
(setvar "errno" 0)
(vla-startundomark adoc)
(while (and (not (vl-catch-all-error-p
(setq ent (vl-catch-all-apply
(function nentsel)
'("\nSelect entity <Exit>:")
)
)
)
)
(/= 52 (getvar "errno"))
)
(if ent
(progn (setq ent (vlax-ename->vla-object (car ent))
lay (vla-item lays (vla-get-layer ent))
color (vla-get-color lay)
)
(if (= (vla-get-lock lay) :vlax-true)
(progn (setq layloc (cons lay layloc))
(vla-put-lock lay :vlax-false)
)
)
(vl-catch-all-apply (function vla-put-color) (list ent color))
(vla-regen adoc acallviewports)
)
(princ "\nNothing selection! Try again.")
)
)
(foreach i layloc (vla-put-lock i :vlax-true))
(vla-endundomark adoc)
(princ)
)

Lisp from #50 (http://www.cadtutor.net/forum/showpost.php?p=284744&postcount=50) can change color of nested objects

[flopo]

Thanks VVA, your lisp is perfect. My english is bad, sorry for that.
Only one thing: can this lisp work if i want to select many object at a time? Or only one object at a time?
I want to work this way: copy all the object in a drawing, and change the colour for all new objects (copied) with this lips, and put them in a new layer. This is why i want to select many objects when i use this lisp.
Thanks!

[VVA]

Thanks VVA, your lisp is perfect. My english is bad, sorry for that.
My english is bad too. :)


I want to work this way: copy all the object in a drawing, and change the colour for all new objects (copied) with this lips, and put them in a new layer. This is why i want to select many objects when i use this lisp.
Thanks!


(defun C:COLORFL ( / adoc blocks color ent lays ss i)
;;;Color From Layer
(vl-load-com)
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
lays (vla-get-layers adoc)
)
(setvar "errno" 0)
(vla-startundomark adoc)
(vl-catch-all-apply
'(lambda ()
(while (setq ss (ssget "_:L"))
(setq i '-1)
(repeat (sslength ss)
(setq ent (vlax-ename->vla-object (ssname ss (setq i (1+ i))))
lay (vla-item lays (vla-get-layer ent))
color (vla-get-color lay)
)
(if (= (vla-get-lock lay) :vlax-true)
(progn (setq layloc (cons lay layloc))
(vla-put-lock lay :vlax-false)
)
)
(vl-catch-all-apply (function vla-put-color) (list ent color))
)
)
)
)
(foreach i layloc (vla-put-lock i :vlax-true))
(vla-endundomark adoc)
(princ)
)

[flopo]

Thanks VVA, it's ok!
Is it possible to do the same thing with linetyle, linetypescale and line weight? Thanks!

[VVA]

(defun C:PFL (/ adoc blocks color ent lays ss i linetype lineweight)
;;;Properties From Layer
(vl-load-com)
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
lays (vla-get-layers adoc)
) ;_ end of setq
(setvar "errno" 0)
(vla-startundomark adoc)
(vl-catch-all-apply
'(lambda ()
(while (setq ss (ssget "_:L"))
(setq i '-1)
(repeat (sslength ss)
(setq ent (vlax-ename->vla-object (ssname ss (setq i (1+ i))))
lay (vla-item lays (vla-get-layer ent))
color (vla-get-color lay)
linetype (vla-get-linetype lay)
lineweight (vla-get-lineweight lay)
) ;_ end of setq

(if (= (vla-get-lock lay) :vlax-true)
(progn (setq layloc (cons lay layloc))
(vla-put-lock lay :vlax-false)
) ;_ end of progn
) ;_ end of if
(vl-catch-all-apply
'(lambda ()
(vla-put-color ent color)
(vla-put-linetype ent linetype)
(vla-put-lineweight ent lineweight)
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of repeat
) ;_ end of while
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
(foreach i layloc (vla-put-lock i :vlax-true))
(vla-endundomark adoc)
(princ)
) ;_ end of defun

[flopo]

It's perfect! Thanks!

[flopo]

Something more....
One circle is in layer 1 , this layer has 0,5 lineweight. Actual circle's lineweight is 2 , is not "by layer". Using the lisp, circle's lineweight change back to 0,5.

For me will be ok if, after using the lisp for all objects in a drawing and moving all the objects in a new layer, i will see no changes as colour, linetype, lineweight or linetype scale. I mean, all the objects will look like initial, no matter which layer they are moved in. Is is possible? Thanks!

[VVA]

Try it


(defun C:PFL (/ adoc blocks ent lays ss i color linetype lineweight *error*)
;;;Properties From Layer
(defun *error* (msg)
(setvar "MODEMACRO" "")
(princ msg)
(vla-regen aDOC acactiveviewport)
(bg:progress-clear)
(bg:layer-status-restore)
(princ)
) ;_ end of defun

(vl-load-com)
(command "_.UNDO" "_Mark")
(setvar "CLAYER" "0")
(pfl)
(command "_.Regenall")
(princ "\n*** Command _.UNDO _Back restore previous settings")
(princ)
) ;_ end of defun
(defun pfl ( / layer-list aDOC count *error* color linetype lineweight lays count)
(defun *error* (msg)
(setvar "MODEMACRO" "")
(princ msg)
(vla-regen aDOC acactiveviewport)
(bg:progress-clear)
(bg:layer-status-restore)
(princ)
) ;_ end of defun
(defun _loc_fun ()
(if (= (vla-get-IsXref Blk) :vlax-false)
(progn
(setq count 0)
(if (> (vla-get-count Blk) 100)
(bg:progress-init
(strcat (vla-get-name Blk) " :")
(vla-get-count Blk)
) ;_ end of bg:progress-init
(progn
(setvar "MODEMACRO" (vla-get-name Blk))
) ;_ end of progn
) ;_ end of if
(vlax-for Obj Blk
(setq lay (vla-item lays (vla-get-layer Obj))
color (vla-get-color lay)
linetype (vla-get-linetype lay)
lineweight (vla-get-lineweight lay)
) ;_ end of setq
(bg:progress (setq count (1+ count)))
(vl-catch-all-apply
'(lambda ()
(if (eq (vla-get-color Obj) acByLayer)(vla-put-color Obj color))
(if (eq (vla-get-linetype Obj) "ByLayer") (vla-put-linetype Obj linetype))
(if (eq (vla-get-lineweight Obj) acLnWtByLayer)(vla-put-lineweight Obj lineweight))
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of vlax-for
(bg:progress-clear)
) ;_ end of progn
) ;_ end of if
) ;_ end of defun
(setq aDOC (vla-get-activedocument (vlax-get-acad-object))
lays (vla-get-layers adoc)
) ;_ end of setq
;;; (grtext -1 "Stage 1. Viewing of layers")
(bg:layer-status-save)
(vlax-for Blk (vla-get-Blocks aDOC)
(if (eq (vla-get-IsLayout Blk) :vlax-true)
(_loc_fun)))
(bg:layer-status-restore)
;;; ???????
(setq *PD_LAYER_LST* nil)
)
(defun bg:progress-clear ()
(setq *BG:PROGRESS:MSG* nil)
(setq *BG:PROGRESS:MAXLEN* nil)
(setq *BG:PROGRESS:LPS* nil)
(setvar "MODEMACRO" (vl-princ-to-string *BG:PROGRESS:OM*))
;;;(vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport)
(princ)
)
(defun bg:progress-init (msg maxlen)
;;; msg - message
;;; maxlen - max count
(setq *BG:PROGRESS:OM* (getvar "MODEMACRO"))
(setq *BG:PROGRESS:MSG* (vl-princ-to-string msg))
(setq *BG:PROGRESS:MAXLEN* maxlen)
(setq *BG:PROGRESS:LPS* '-1)(princ)
)
(defun bg:progress ( currvalue / persent str1 count)
(if *BG:PROGRESS:MAXLEN*
(progn
(setq persent (fix (/ currvalue 0.01 *BG:PROGRESS:MAXLEN*)))
;;;Every 5 %
(setq count (fix(* persent 0.2)))
(setq str1 "")
(if (/= count *BG:PROGRESS:LPS*)
(progn
;;(setq str1 "")
(repeat persent (setq str1 (strcat str1 "|")))
)
)
;;; currvalue - current value
(setvar "MODEMACRO"
(strcat (vl-princ-to-string *BG:PROGRESS:MSG*)
" "
(itoa persent)
" % "
str1
)
)
(setq *BG:PROGRESS:LPS* persent)
)
)
)
(defun bg:layer-status-restore ()
(foreach item *PD_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 lambda
) ;_ end of vl-catch-all-apply
) ;_ end of if
) ;_ end of foreach
(setq *PD_LAYER_LST* nil)
) ;_ end of defun

(defun bg:layer-status-save ()
(setq *PD_LAYER_LST* nil)
(vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(setq *PD_LAYER_LST* (cons (list item
(cons "freeze" (vla-get-freeze item))
(cons "lock" (vla-get-lock item))
) ;_ end of cons
*PD_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 vlax-for
) ;_ end of defun

[flopo]

This last lisp is exaclty what I wanted. Thanks!

[dannypd]

Is it possible to save changes to xref colors?
John


Command:
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
*** Add 20.03.2009 - Now ColorX ColorXREF work with Attrubutes
*** Add 31.03.2009 - Now ColorX and ColorXREF colored dimension (include radius).
*** Add 02.04.2009 - Change color Qleader, Mtext, Mleader. Add Simple progressbar

If you want to operate colour of xref objects in the blanket drawing:
1. Open Xref (sourcing drawing.dwg)
2. Run ColorX and set color bylayer
3.open a blanket drawing
4. Creat layer "Xref"
5. Set layer "Xref" current
6 use xref command to attach the source drawing (sourcing drawing.dwg)
7.change the xref color in layer manager. choose grey
NOTE. If some objects in xref (sourcing drawing.dwg) are placed on a layer 0 your mast change layer of an insert of the external reference in a blanket drawing to grey too. (layer "XREF")
I do not know as this technical term sounds in English. I translate from Russian: there Is an emersion of a layer 0. All objects located on 0 layer in drawing of the external reference (sourcing drawing.dwg) inherit properties of a external reference layer in blanket drawing (layer "XREF")

[dannypd]

Is it possible to save the layer color status when exit?

Command:
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
*** Add 20.03.2009 - Now ColorX ColorXREF work with Attrubutes
*** Add 31.03.2009 - Now ColorX and ColorXREF colored dimension (include radius).
*** Add 02.04.2009 - Change color Qleader, Mtext, Mleader. Add Simple progressbar

If you want to operate colour of xref objects in the blanket drawing:
1. Open Xref (sourcing drawing.dwg)
2. Run ColorX and set color bylayer
3.open a blanket drawing
4. Creat layer "Xref"
5. Set layer "Xref" current
6 use xref command to attach the source drawing (sourcing drawing.dwg)
7.change the xref color in layer manager. choose grey
NOTE. If some objects in xref (sourcing drawing.dwg) are placed on a layer 0 your mast change layer of an insert of the external reference in a blanket drawing to grey too. (layer "XREF")
I do not know as this technical term sounds in English. I translate from Russian: there Is an emersion of a layer 0. All objects located on 0 layer in drawing of the external reference (sourcing drawing.dwg) inherit properties of a external reference layer in blanket drawing (layer "XREF")

[maksolino]

Hello
1. colorfl is very nice lisp but I would like to have
the possibility to select more entities at once
2. colorx it's also nice but for me it will be better
whith the possibility to select the entities for changing the colour (not all)
Thanks

[maksolino]

Hello
1. colorfl is very nice lisp but I would like to have
the possibility to select more entities at once
2. colorx it's also nice but for me it will be better
whith the possibility to select the entities for changing the colour (not all)
Thanks

[VVA]

Hello
1. colorfl is very nice lisp but I would like to have
the possibility to select more entities at once

Look this version (http://www.cadtutor.net/forum/showpost.php?p=285235&postcount=52)


2. colorx it's also nice but for me it will be better
whith the possibility to select the entities for changing the colour (not all)
Thanks

Try It


(defun c:blcc () (pl:block-color) (princ))
(defun c:encc () (pl:block-ent-color) (princ))
;;;get from Alaspher http://forum.dwg.ru/showthread.php?t=1036
;;; http://forum.dwg.ru/showpost.php?p=166220&postcount=18
(vl-load-com)
(defun pl:block-ent-color (/ adoc blocks color ent lays)
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
lays (vla-get-layers adoc)
color (acad_colordlg 256)
)
(if color
(progn (setvar "errno" 0)
(vla-startundomark adoc)
(while (and (not (vl-catch-all-error-p
(setq ent (vl-catch-all-apply
(function nentsel)
'("\nSelect entity <Exit>:")
)
)
)
)
(/= 52 (getvar "errno"))
)
(if ent
(progn (setq ent (vlax-ename->vla-object (car ent))
lay (vla-item lays (vla-get-layer ent))
)
(if (= (vla-get-lock lay) :vlax-true)
(progn (setq layloc (cons lay layloc))
(vla-put-lock lay :vlax-false)
)
)
(vl-catch-all-apply (function vla-put-color) (list ent color))
(vla-regen adoc acallviewports)
)
(princ "\nNothing selection! Try again.")
)
)
(foreach i layloc (vla-put-lock i :vlax-true))
(vla-endundomark adoc)
)
)
(princ)
)

(defun pl:block-color (/ adoc blocks color ins lays)
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
blocks (vla-get-blocks adoc)
lays (vla-get-layers adoc)
color (acad_colordlg 256)
)
(if color
(progn (setvar "errno" 0)
(vla-startundomark adoc)
(while (and (not (vl-catch-all-error-p
(setq ins (vl-catch-all-apply
(function entsel)
'("\nSelect block <Exit>:")
)
)
)
)
(/= 52 (getvar "errno"))
)
(if ins
(progn (setq ins (vlax-ename->vla-object (car ins)))
(if (= (vla-get-objectname ins) "AcDbBlockReference")
(if (vlax-property-available-p ins 'path)
(princ "\nThis is external reference! Try pick other.")
(progn (_pl:block-color blocks ins color lays)
(vla-regen adoc acallviewports)
)
)
(princ "\nThis isn't block! Try pick other.")
)
)
(princ "\nNothing selection! Try again.")
)
)
(vla-endundomark adoc)
)
)
(princ)
)

(defun _pl:block-color (blocks ins color lays / lay layfrz layloc)
(vlax-for e (vla-item blocks (vla-get-name ins))
(setq lay (vla-item lays (vla-get-layer e)))
(if (= (vla-get-freeze lay) :vlax-true)
(progn (setq layfrz (cons lay layfrz)) (vla-put-freeze lay :vlax-false))
)
(if (= (vla-get-lock lay) :vlax-true)
(progn (setq layloc (cons lay layloc)) (vla-put-lock lay :vlax-false))
)
(vl-catch-all-apply (function vla-put-color) (list e color))
(if (and (= (vla-get-objectname e) "AcDbBlockReference")
(not (vlax-property-available-p e 'path))
)
(_pl:block-color blocks e color lays)
)
(foreach i layfrz (vla-put-freeze i :vlax-true))
(foreach i layloc (vla-put-lock i :vlax-true))
)
)

(progn
(princ "\BLCC - Changes color of the chosen blocks")
(princ "\nENCC - Changes color of the chosen objects (may be element of the block)")
(princ))

[rayg11757]

I am not sure if I should post here or start a new thread. The posts here are cool and on track for what I am looking to do. The “encc” routine by VVA is awesome and very close to what I am looking to do.

BACKGROUND: I have blocks that contain multiple attributes. The attributes are on different layers so that they may be turned on and off independently from each other. The attribute color is defined and fixed within the block, so that the text line weight will be correct at plotting time. The lines for all objects are drawn on layer “0” so that the objects can take on the color properties of the layer where the block is placed. This permits the text lineweight to be independent from the objects lineweights during plotting.

THE PROBLEM: In some instances, the blocks describe new work, where the object lines are printed very heavy, and the text prints a medium-weight black. In other instances, the blocks describe existing work, and I move them to a layer that prints gray. However, the attribute text continues retain the original color and to print black. I desire to change the text color to a different shade of gray so that the text plots lighter.

THE SOLUTION: Ideally I would like to select multiple blocks and override the color of all text attributes within those block simultaneously, without changing the block definition. I would like the blocks that are not selected to remain unchanged.

Is anyone aware of any lisp code to accomplish these attribute text color changes?

Thank you for your help.
Ray

PS Unfortunately, I am still using 2006.

[Lee Mac]

Hi Ray,

Give this a shot mate, apologies for slow selection process, but a blanket change may require altering the block definition - will see what I can do.



(defun c:attcol (/ col ent obj)
(vl-load-com)

(if (setq col (acad_colordlg 256))

(while
(progn
(setq ent (car (nentsel "\nSelect Attribute to Change: ")))

(cond ( (eq 'ENAME (type ent))

(if (eq "AcDbAttribute"
(vla-get-ObjectName
(setq obj (vlax-ename->vla-object ent))))

(not (vla-put-color obj col)) t))))))
(princ))

[Lee Mac]

Actually, try this:



(defun c:attcol2 (/ i col ss ent elst)

(if (and (setq i -1 col (acad_colordlg 256))
(setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1)))))

(while (setq ent (ssname ss (setq i (1+ i))))

(while (/= "SEQEND" (cdr (assoc 0 (setq elst (entget (setq ent (entnext ent)))))))

(entmod
(if (assoc 62 elst)
(subst (cons 62 col) (assoc 62 elst) elst)
(append elst (list (cons 62 col))))))))

(princ))

[Lee Mac]

Actually, this may suit you better :)



(defun c:attcol3 (/ unique dcl_write Set_Img

CATT DCTAG DLST ENT FNAME I ITM OBJ OLST PTR SS)

;; By Lee McDonnell (Lee Mac) ~ 28.12.2009
(vl-load-com)

(setq fname "LMAC_ATTCOL_V1.0.dcl")
(or *attcol* (setq *attcol* 1)) ;; Default Colour

(defun unique (lst / result)
(reverse
(while (setq itm (car lst))
(setq lst (vl-remove itm lst)
result (cons itm result)))))

(defun dcl_write (fname / wPath ofile)

(if (not (findfile fname))

(if (setq wPath (findfile "ACAD.PAT"))
(progn
(setq wPath (vl-filename-directory wPath))

(or (eq "\\" (substr wPath (strlen wPath)))
(setq wPath (strcat wPath "\\")))

(setq ofile (open (strcat wPath fname) "w"))

(foreach str

'("attcol : dialog { label = \"Attribute Colour\";"
" : text { alignment = right; label = \"Lee McDonnell 2009\"; }"
" : list_box { label = \"Select Tags\"; key = \"tags\"; fixed_width = false;"
" multiple_select = true ; alignment = centered; }"
" : boxed_column { label = \"Colour\";"
" : row { spacer;"
" : button { key = \"cbut\"; width = 12; fixed_width = true; label = \"Select Colour\"; }"
" : image_button { key = \"cimg\"; alignment = centered; height = 1.5; width = 4.0;"
" fixed_width = true; fixed_height = true; color = 2; }"
" spacer;"
" }"
" spacer;"
" }"
" spacer;"
" ok_cancel;"
"}")

(write-line str ofile))

(close ofile)

t) ; File written successfully

nil) ; Filepath not Found

t)) ; DCL file already exists


(defun Set_Img (key col)
(start_image key)
(fill_image 0 0 (dimx_tile key) (dimy_tile key) col)
(end_image))


(if (and (dcl_write fname)
(setq i -1 ss (ssget "_:L" '((0 . "INSERT") (66 . 1)))))
(progn

(while (setq ent (ssname ss (setq i (1+ i))))

(foreach att (append
(vlax-safearray->list
(vlax-variant-value
(vla-getAttributes
(setq obj (vlax-ename->vla-object ent)))))

(cond ( (vl-catch-all-error-p
(setq cAtt
(vl-catch-all-apply
(function vlax-safearray->list)
(list
(vlax-variant-value
(vla-getConstantAttributes obj)))))) nil)
(cAtt)))

(setq oLst (cons (cons (vla-get-TagString att) att) oLst))))

(cond ( (<= (setq dcTag (load_dialog fname)) 0)

(princ "\n** Dialog File could not be Found **"))

( (not (new_dialog "attcol" dcTag))

(princ "\n** Dialog Could not be Loaded **"))

(t
(start_list "tags")

(mapcar (function add_list)
(setq dLst
(acad_strlsort
(Unique
(mapcar (function car) oLst)))))
(end_list)

(setq ptr (set_tile "tags" "0"))
(Set_Img "cimg" *attcol*)

(action_tile "cimg"
(vl-prin1-to-string
(quote
(progn
(Set_Img "cimg"
(setq *attcol* (cond ((acad_colordlg *attcol*)) (*attcol*))))))))

(action_tile "cbut"
(vl-prin1-to-string
(quote
(progn
(Set_Img "cimg"
(setq *attcol* (cond ((acad_colordlg *attcol*)) (*attcol*))))))))

(action_tile "tags" "(setq ptr $value)")
(action_tile "accept" "(done_dialog)")
(action_tile "cancel" "(setq ptr nil) (done_dialog)")

(start_dialog)
(unload_dialog dcTag)

(if ptr
(progn
(setq ptr
(mapcar
(function
(lambda (x) (nth x dLst))) (read (strcat "(" ptr ")"))))

(mapcar
(function
(lambda (x)
(and (vl-position (car x) ptr)
(vla-put-color (cdr x) *attcol*)))) oLst))

(princ "\n*Cancel*"))))))
(princ))

[rayg11757]

Lee Mac,

Awesome... Thank you !!!

Attcol2 is exactly what I need. Attcol1 provides good manual control and will be useful, but Attcol3 provides so much flexiblity and the ability to select any number of attributes independently is incredible.

Thanks again for your help.

Ray

[Lee Mac]

You're welcome Ray - I had fun with it :)

[saiden_ea]

hi,

i need to download a lisp file; colorx, colorxref, colorxl & colorxrefl...

tnx...

[ichlove]

This lisp can only select one block every time, is that possible to have select area?and each area can change the color you want?

Thanks

Look this version (http://www.cadtutor.net/forum/showpost.php?p=285235&postcount=52)

Try It


(defun c:blcc () (pl:block-color) (princ))
(defun c:encc () (pl:block-ent-color) (princ))
;;;get from Alaspher http://forum.dwg.ru/showthread.php?t=1036
;;; http://forum.dwg.ru/showpost.php?p=166220&postcount=18
(defun pl:block-ent-color (/ adoc blocks color ent lays)
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
lays (vla-get-layers adoc)
color (acad_colordlg 256)
)
(if color
(progn (setvar "errno" 0)
(vla-startundomark adoc)
(while (and (not (vl-catch-all-error-p
(setq ent (vl-catch-all-apply
(function nentsel)
'("\nSelect entity <Exit>:")
)
)
)
)
(/= 52 (getvar "errno"))
)
(if ent
(progn (setq ent (vlax-ename->vla-object (car ent))
lay (vla-item lays (vla-get-layer ent))
)
(if (= (vla-get-lock lay) :vlax-true)
(progn (setq layloc (cons lay layloc))
(vla-put-lock lay :vlax-false)
)
)
(vl-catch-all-apply (function vla-put-color) (list ent color))
(vla-regen adoc acallviewports)
)
(princ "\nNothing selection! Try again.")
)
)
(foreach i layloc (vla-put-lock i :vlax-true))
(vla-endundomark adoc)
)
)
(princ)
)

(defun pl:block-color (/ adoc blocks color ins lays)
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
blocks (vla-get-blocks adoc)
lays (vla-get-layers adoc)
color (acad_colordlg 256)
)
(if color
(progn (setvar "errno" 0)
(vla-startundomark adoc)
(while (and (not (vl-catch-all-error-p
(setq ins (vl-catch-all-apply
(function entsel)
'("\nSelect block <Exit>:")
)
)
)
)
(/= 52 (getvar "errno"))
)
(if ins
(progn (setq ins (vlax-ename->vla-object (car ins)))
(if (= (vla-get-objectname ins) "AcDbBlockReference")
(if (vlax-property-available-p ins 'path)
(princ "\nThis is external reference! Try pick other.")
(progn (_pl:block-color blocks ins color lays)
(vla-regen adoc acallviewports)
)
)
(princ "\nThis isn't block! Try pick other.")
)
)
(princ "\nNothing selection! Try again.")
)
)
(vla-endundomark adoc)
)
)
(princ)
)

(defun _pl:block-color (blocks ins color lays / lay layfrz layloc)
(vlax-for e (vla-item blocks (vla-get-name ins))
(setq lay (vla-item lays (vla-get-layer e)))
(if (= (vla-get-freeze lay) :vlax-true)
(progn (setq layfrz (cons lay layfrz)) (vla-put-freeze lay :vlax-false))
)
(if (= (vla-get-lock lay) :vlax-true)
(progn (setq layloc (cons lay layloc)) (vla-put-lock lay :vlax-false))
)
(vl-catch-all-apply (function vla-put-color) (list e color))
(if (and (= (vla-get-objectname e) "AcDbBlockReference")
(not (vlax-property-available-p e 'path))
)
(_pl:block-color blocks e color lays)
)
(foreach i layfrz (vla-put-freeze i :vlax-true))
(foreach i layloc (vla-put-lock i :vlax-true))
)
)

(progn
(princ "\BLCC - Changes color of the chosen blocks")
(princ "\nENCC - Changes color of the chosen objects (may be element of the block)")
(princ))

[VVA]

This lisp can only select one block every time, is that possible to have select area?and each area can change the color you want?
Try it


(defun c:blccA ()
;;;blccA - BLock Change Color Area
(pl:block-colorA)
(princ)
) ;_ end of defun
;;;get from Alaspher http://forum.dwg.ru/showthread.php?t=1036
;;; http://forum.dwg.ru/showpost.php?p=166220&postcount=18
(defun pl:block-colorA (/ adoc blocks color ins lays ss lst)
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
blocks (vla-get-blocks adoc)
lays (vla-get-layers adoc)
) ;_ end of setq
(if (and (setq color (acad_colordlg 256))
(setq ss (ssget '((0 . "INSERT"))))
(progn
(repeat (setq ins (sslength ss)) ;_ end setq
(setq lst (cons (ssname ss (setq ins (1- ins))) lst))
) ;_ end repeat
lst
) ;_ end of progn
) ;_ end of and
(progn
(vla-startundomark adoc)
(foreach ins lst
(setq ins (vlax-ename->vla-object ins))
(if (= (vla-get-objectname ins) "AcDbBlockReference")
(if (vlax-property-available-p ins 'path)
(princ "\nThis is external reference! Skip.")
(_pl:block-color blocks ins color lays)
) ;_ end of if
(princ "\nThis isn't block! Try pick other.")
) ;_ end of if
) ;_ end of repeat
(vla-regen adoc acallviewports)
(vla-endundomark adoc)
) ;_ end of progn
) ;_ end of if
(princ)
) ;_ end of defun

(defun _pl:block-color (blocks ins color lays / lay layfrz layloc)
(vlax-for e (vla-item blocks (vla-get-name ins))
(setq lay (vla-item lays (vla-get-layer e)))
(if (= (vla-get-freeze lay) :vlax-true)
(progn (setq layfrz (cons lay layfrz))
(vla-put-freeze lay :vlax-false)
) ;_ end of progn
) ;_ end of if
(if (= (vla-get-lock lay) :vlax-true)
(progn (setq layloc (cons lay layloc))
(vla-put-lock lay :vlax-false)
) ;_ end of progn
) ;_ end of if
(vl-catch-all-apply (function vla-put-color) (list e color))
(if (and (= (vla-get-objectname e) "AcDbBlockReference")
(not (vlax-property-available-p e 'path))
) ;_ end of and
(_pl:block-color blocks e color lays)
) ;_ end of if
(foreach i layfrz (vla-put-freeze i :vlax-true))
(foreach i layloc (vla-put-lock i :vlax-true))
) ;_ end of vlax-for
) ;_ end of defun

(progn
(princ
"\BLCCA - Changes in the color of selected blocks in the area"
) ;_ end of princ
(princ)
) ;_ end of progn

[ichlove]

Thanks,VVA!

Is that possible the select area also includes none-block objects and multileader?




Try it


(defun c:blccA ()
;;;blccA - BLock Change Color Area
(pl:block-colorA)
(princ)
) ;_ end of defun
;;;get from Alaspher http://forum.dwg.ru/showthread.php?t=1036
;;; http://forum.dwg.ru/showpost.php?p=166220&postcount=18
(defun pl:block-colorA (/ adoc blocks color ins lays ss lst)
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
blocks (vla-get-blocks adoc)
lays (vla-get-layers adoc)
) ;_ end of setq
(if (and (setq color (acad_colordlg 256))
(setq ss (ssget '((0 . "INSERT"))))
(progn
(repeat (setq ins (sslength ss)) ;_ end setq
(setq lst (cons (ssname ss (setq ins (1- ins))) lst))
) ;_ end repeat
lst
) ;_ end of progn
) ;_ end of and
(progn
(vla-startundomark adoc)
(foreach ins lst
(setq ins (vlax-ename->vla-object ins))
(if (= (vla-get-objectname ins) "AcDbBlockReference")
(if (vlax-property-available-p ins 'path)
(princ "\nThis is external reference! Skip.")
(_pl:block-color blocks ins color lays)
) ;_ end of if
(princ "\nThis isn't block! Try pick other.")
) ;_ end of if
) ;_ end of repeat
(vla-regen adoc acallviewports)
(vla-endundomark adoc)
) ;_ end of progn
) ;_ end of if
(princ)
) ;_ end of defun

(defun _pl:block-color (blocks ins color lays / lay layfrz layloc)
(vlax-for e (vla-item blocks (vla-get-name ins))
(setq lay (vla-item lays (vla-get-layer e)))
(if (= (vla-get-freeze lay) :vlax-true)
(progn (setq layfrz (cons lay layfrz))
(vla-put-freeze lay :vlax-false)
) ;_ end of progn
) ;_ end of if
(if (= (vla-get-lock lay) :vlax-true)
(progn (setq layloc (cons lay layloc))
(vla-put-lock lay :vlax-false)
) ;_ end of progn
) ;_ end of if
(vl-catch-all-apply (function vla-put-color) (list e color))
(if (and (= (vla-get-objectname e) "AcDbBlockReference")
(not (vlax-property-available-p e 'path))
) ;_ end of and
(_pl:block-color blocks e color lays)
) ;_ end of if
(foreach i layfrz (vla-put-freeze i :vlax-true))
(foreach i layloc (vla-put-lock i :vlax-true))
) ;_ end of vlax-for
) ;_ end of defun

(progn
(princ
"\BLCCA - Changes in the color of selected blocks in the area"
) ;_ end of princ
(princ)
) ;_ end of progn

[VVA]

Thanks,VVA!
Is that possible the select area also includes none-block objects and multileader?
Try it


(defun c:colorA (/ adoc blocks color ins lays ss lst *error*)
;;; Color Area - - Changes in the color of selected items in the area
;;;http://www.cadtutor.net/forum/showthread.php?t=533&page=8
;;;get from Alaspher http://forum.dwg.ru/showthread.php?t=1036
;;; http://forum.dwg.ru/showpost.php?p=166220&postcount=18
(defun *error* (msg)(bg:layer-status-restore)(princ msg)(princ))
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
blocks (vla-get-blocks adoc)
lays (vla-get-layers adoc)
) ;_ end of setq
(if (and (setq color (acad_colordlg 256))
(setq ss (ssget))
(progn
(repeat (setq ins (sslength ss)) ;_ end setq
(setq lst (cons (ssname ss (setq ins (1- ins))) lst))
) ;_ end repeat
lst
) ;_ end of progn
) ;_ end of and
(progn
(vla-startundomark adoc)
(bg:layer-status-save)
(foreach ins lst
(setq ins (vlax-ename->vla-object ins))
(if (= (vla-get-objectname ins) "AcDbBlockReference")
(if (vlax-property-available-p ins 'path)
(princ "\nThis is external reference! Skip.")
(progn
(_pl:block-color blocks ins color lays)
(Change-Object-Color ins color)
)
) ;_ end of if
(Change-Object-Color ins color)
) ;_ end of if

) ;_ end of repeat
(vla-regen adoc acallviewports)
(bg:layer-status-restore)
(vla-endundomark adoc)
) ;_ end of progn
) ;_ end of if
(princ)
) ;_ end of defun

(defun _pl:block-color (blocks ins color lays / lay layfrz layloc)
(vlax-for e (vla-item blocks (vla-get-name ins))
(setq lay (vla-item lays (vla-get-layer e)))
(if (= (vla-get-freeze lay) :vlax-true)
(progn (setq layfrz (cons lay layfrz))
(vla-put-freeze lay :vlax-false)
) ;_ end of progn
) ;_ end of if
(if (= (vla-get-lock lay) :vlax-true)
(progn (setq layloc (cons lay layloc))
(vla-put-lock lay :vlax-false)
) ;_ end of progn
) ;_ end of if
(vl-catch-all-apply (function vla-put-color) (list e color))
(if (and (= (vla-get-objectname e) "AcDbBlockReference")
(not (vlax-property-available-p e 'path))
) ;_ end of and
(_pl:block-color blocks e color lays)
) ;_ end of if
(foreach i layfrz (vla-put-freeze i :vlax-true))
(foreach i layloc (vla-put-lock i :vlax-true))
) ;_ end of vlax-for
) ;_ end of defun
(defun Change-Object-Color (Obj Color / txtstr tmp txt)
;;;=============================================== =========================
;;;_color object start
(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 acByBlock)) ;_Color
(vl-catch-all-apply 'vla-put-TextColor (list Obj acByBlock)) ;_Color
(vl-catch-all-apply 'vla-put-DimensionLineColor (list Obj acByBlock));_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 acByBlock) ;_Color
(vl-catch-all-apply 'vla-put-LeaderLineColor (list Obj tmp))
)
)
(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 txtstr
((lambda (mtext / text str)
(setq Text "")
(while (/= Mtext "")
(cond
((wcmatch(strcase (setq Str (substr Mtext 1 3)))"{\\C") ;_ end of wcmatch
(setq Mtext(substr Mtext (+ 2 (vl-string-search ";" Mtext)))) ;_ end of setq
)
((wcmatch(strcase (setq Str (substr Mtext 1 2)))"\\C")
(setq Mtext(substr Mtext (+ 2 (vl-string-search ";" Mtext))))
)
((wcmatch(strcase (setq Str (substr Mtext 1 2))) "\\[{}]")
(setq Text (strcat Text (substr Mtext 1 2))
Mtext (substr Mtext 3)
) ;_ end of setq
)
((wcmatch (substr Mtext 1 1) "[{}]")
(setq Mtext (substr Mtext 2))
)
(t
(setq Text (strcat Text (substr Mtext 1 1))
Mtext (substr Mtext 2)
) ;_ end of setq
)
) ;_ end of cond
) ;_ end of while
text
) ;_lambda
txtstr
)
)
(vlax-put-property Obj 'TextString (strcat "{\\C" (itoa color) ";" txtstr "}"))
);_progn
)

) ;_ end of progn
) ;_ end of if
;;;_color object end
;;;=============================================== =========================
) ;_ end of defun
(defun bg:layer-status-restore ()
(foreach item *BG_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 lambda
) ;_ end of vl-catch-all-apply
) ;_ end of if
) ;_ end of foreach
(setq *BG_LAYER_LST* nil)
) ;_ end of defun

(defun bg:layer-status-save ()
(setq *BG_LAYER_LST* nil)
(vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(setq *BG_LAYER_LST* (cons (list item
(cons "freeze" (vla-get-freeze item))
(cons "lock" (vla-get-lock item))
) ;_ end of cons
*BG_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 vlax-for
) ;_ end of defun
(progn
(princ
"\ColorA - Changes in the color of selected items in the area"
) ;_ end of princ
(princ)
) ;_ end of progn

[michaelriver23]

VVA-

I have used colorxref, this is exactly what i need. but . . .

I work for an MEP firm, we receive dwg's from architects in full color, but usually have to go through some process of either binding down all the xref'd dwg then bursting and erasing and changing layer color to get it down to one solid background.

the current project we have which is going to go on for the next 4 years and comes from and archiecture firm that is infamous for weekly drawing changes.

I need something that allows me to change the colors all the way down through nested xref and inlcuding block changes, but changes the colors by layer. Also it is ok if it changes the xref'd files. I just need something automatic, I like the result of colorxref, but i can't save with that.

thanks

[bograd]

Hello,

Is there a way to select an object (which usually contains severals blocks with different layers) and select a color for the final block?
To achieve this i need to explode the block several time and then change the color. Can this be done just by selecting the block and the color?

To put it simple, i need exactly the same ColorX lsp posted on the first page of the thread, but to apply only to the objects i select.

[bograd]

I found a solution.
I used norm.lsp found in other thread, and afetr that i can change the color to any block i need.

[VVA]

I found a solution.
I used norm.lsp found in other thread, and afetr that i can change the color to any block i need.
This is the best solution. Another variant:
BLCC - Changes color of the chosen blocks
ENCC - Changes color of the chosen objects (may be element of the block) (http://www.cadtutor.net/forum/showpost.php?p=291428&postcount=63)

>michaelriver23 I need more time to see what can I do

[bograd]

I get an error: "; error: no function definition: VLAX-GET-ACAD-OBJECT"
I use AutoCAD 2002 bay the way.

[VVA]

I get an error: "; error: no function definition: VLAX-GET-ACAD-OBJECT"
I use AutoCAD 2002 bay the way.
This will help you (http://www.cadforum.cz/cadforum_en/qaID.asp?tip=5638)
PS I corrected the code for the link in previous post

[bograd]

Awesome!. Thank you for your help.

[bono05]

Hi everybody,

I'ts possible to have the command lisp Colorx ...without he's calling a dialog box?

Many thanks!

[Least]

VVA
colorx is great, I also need to give the xref one a go.
Not sure what the other variants do, I kind of got lost with alll the different requests.

Sometimes I need to change the colour of all the objects in a drawing just like colourx already does, but sometimes I need to do the opposite. The drawing may be recieved completly one colour and I need to restore all the layer colours as they are in the layer property manager. Any chance of a modification to enable this restore feature? I can select all and set to bylayer, but it doesn't work with any attributes.

Many thanks
Pads

edit: ah silly me, of course I can just select 'bylayer' in the select colour pop up.

cheers!

[VVA]

Hi everybody,

I'ts possible to have the command lisp Colorx ...without he's calling a dialog box?

Many thanks!
Replace COLORX command in your lisp file or add as new command


(defun C:COLORX (/ 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

[bono05]

Many thanks VVA!!

Now i can use it with SuperAutoScript...:D

[PORT80]

Hello VVA,

Awesome lisp routine! I was wondering how to make the color bylayer change thru the Layer Properties Manager instead of forcing the color? I noticed the lisp forces the color properties to the desired color of choice. Here is an example of the process I am trying to use.

First I open the Layer Properties Manager - select all layers - unlock all layers - change all colors to 253
Next I go to modify - change to bylayer - select all - Y- Y and process complete.

I have used your ColorX lisp and it works like a champ however it is difficult to manage the colors once they are forced to the color of choice.

I am fairly new to writing lisp but do know many of the functions and features of AutoCad. I am now expanding my AutoCad knowledge to VBA, Lisp and automation. Any help would be greatly appreciated.

Thank you for your time and efforts.

Sincerely,

Micahel

[VVA]

I do not quite understand what the problem is?
To change the color to "bylayer" You can call ColorX and select the appropriate button. Beginning with the 2008 version of AutoCAD command is added _setbylayer.

[elleHCSC]

Hello VVA,

myfile:
http://www.mediafire.com/?jx011z72z4py6jh

I have some blocks in my dwg. I just only want to change color of some block (not all) like this examble file by lisp. Can you help me ?

sorry for my bad english.

Thank you for your time and efforts.

[VVA]

I have some blocks in my dwg. I just only want to change color of some block (not all) like this examble file by lisp. Can you help me ?

Yes
BLCC - Changes color of the chosen blocks
ENCC - Changes color of the chosen objects (may be element of the block) (http://www.cadtutor.net/forum/showpost.php?p=291428&postcount=63)
Or
ColorA - Changes in the color of selected items in the area (http://www.cadtutor.net/forum/showthread.php?533-Lisp-colour-change-for-all-layers-and-blocks&p=335976&viewfull=1#post335976)

[elleHCSC]

Tks VVA, i know BLCC, ENCC, ColorX lisp but i mean that in my dwg when i select 1 block then only this block to be change color.

[VVA]

In the Block Editors set for all entities
layer - 0
color - byblock
Or load norm-blocks.lsp (http://www.cadtutor.net/forum/showthread.php?47075-Edit-Multiple-Blocks-(color)-at-once&p=321554&viewfull=1#post321554) and type in command line


Command: (norm-blocks 9)

[elleHCSC]

tks VVA and forum, that great.

[Cadikimmo]

Thanks for great lisp, but if yo don't want use lisp, so can you do same thing just entering commands?

[saunambon654]

What perfect! But can you create each layer for each color and put all objects same color in same layer?

[VVA]

What perfect! But can you create each layer for each color and put all objects same color in same layer?
Try it



(defun C:C2L (/ tmp txt count TrueColor layFilter lay)
;;;http://forum.dwg.ru/showthread.php?p=1069183
;;;http://www.cadtutor.net/forum/showthread.php?533-Lisp-colour-change-for-all-layers-and-blocks/page10
;;; Color To Layer
;;; layFilter - Layer List
;;;If the colors are not in the list of layers, the layer will be called Color_Number.
;;;For example, for 123 colors -> Layer name "Color _123"
;;;color R = 12 G = 32 B = 65 -> Layer name "Color _12_32_65"
(setq layFilter
(list
'((143 134 112) "MyLay1") ;_entity with color R = 143 G = 134 B = 112 is transferred to the layer "MyLay1"
'((110 87 168) "MyLay2") ;_entity with color R = 110 G = 87 B = 168 is transferred to the layer "MyLay2"
'((1) "Red") ;_entity with color ACI = 1 is transferred to the layer "Red"
'((2) "Yellow") ;_entity with color ACI = 2 is transferred to the layer "Yellow"
'((3) "Green") ;_entity with color ACI = 3 is transferred to the layer "Green"
) ;_ end of list
) ;_ end of setq
(vl-load-com)
(vlax-for Blk (vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
) ;_ end of vla-get-Blocks
(if (eq (vla-get-isxref Blk) :vlax-false)
(progn
(setq count 0
txt (strcat "Changed " (vla-get-name Blk))
) ;_ end of setq
(grtext -1 txt)
(vlax-for Obj Blk
(setq count (1+ count))
(if (zerop (rem count 10))
(grtext -1 (strcat txt " : " (itoa count)))
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'Color)
) ;_ end of and
(setq tmp
(if
(= (vla-get-colormethod
(setq TrueColor (vla-get-truecolor Obj))
) ;_ end of vla-get-ColorMethod
accolormethodbyrgb
) ;_ end of =
(list (vla-get-red TrueColor)
(vla-get-green TrueColor)
(vla-get-blue TrueColor)
) ;_ end of list
(cond ((eq (vla-get-color obj) acbyblock)
nil
)
((eq (vla-get-color obj) acbylayer)
nil
)
(t (list (vla-get-color obj)))
) ;_ end of cond
) ;_ end of if
) ;_ end of setq
(setq tmp nil)
) ;_ end of if
(or (setq lay (cadr (assoc tmp layFilter)))
(setq
lay (strcat
"Color"
(apply
'strcat
(mapcar '(lambda (x) (strcat "_" (itoa x))) tmp)
) ;_ end of apply
) ;_ end of strcat
) ;_ end of setq
) ;_ end of or
(if (and tmp (listp tmp) (vlax-write-enabled-p Obj))
(entmod
(subst
(cons
8
lay
) ;_ end of cons
(assoc 8 (entget (vlax-vla-object->ename obj)))
(entget (vlax-vla-object->ename obj))
) ;_ end of subst
) ;_ end of entmod
) ;_ end of if
) ;_ end of vlax-for
) ;_ end of progn
) ;_ end of if
) ;_ end of vlax-for
(vl-cmdf "_regenall")
(princ)
) ;_ end of defun

[saunambon654]

Thank you! It's good, but no work for "bylayer" color.

[VVA]

found


(cond ((eq (vla-get-color obj) acbyblock)
nil
)
((eq (vla-get-color obj) acbylayer)
nil
)

and change


(cond ((eq (vla-get-color obj) acbyblock)
(list 888) ;_byblock
)
((eq (vla-get-color obj) acbylayer)
(list 999) ;_Bylayer
)

[saunambon654]

nice! thanks so much! :)

[brianmcguire]

I am sure you hear this all the time. this is awesome. I am new to Codingand lisp but this is perfect. I am trying to figure out how to do this as ascript on multiple drawings. The only thing stopping me in the ACI colordialogue box pop up. Is there a way to tell it to input "8" thenenter so it will run as a script. You may have covered this already. Eitherway, you are a coding genus so thank you very much.

[VVA]

brianmcguire see post #84 (http://www.cadtutor.net/forum/showthread.php?533-Lisp-colour-change-for-all-layers-and-blocks&p=357873&viewfull=1#post357873) or use your function


(defun mycolorXfunc ( col / doc)
;col — color number
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(mip:layer-status-save)
(ChangeAllObjectsColor doc col) ;_ col — color number
(mip:layer-status-restore)
(vla-endundomark doc)
(princ)
) ;_ end of defun

Use

(mycolorXfunc 8)

[brianmcguire]

Thank you very much. this probably has to be one of the oldest string around but so darn useful. thanks again for you hard work and efforts.