Color 2 Layer

Jeff has a great routine below for changing the color in a specified layer.
I am wondering how to modify it it change xref layers with a wild card
ex: (Color2Layer 8 "*|A-PATT-POCH") does not work

Gary

;;;by Jeff Mishler
;;; (Color2Layer 8 "A-PATT-POCH")

(defun Color2Layer (color layer / atts doc lay lays lokt)
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for
lay (vla-get-layers doc)
(if (and (= color (vla-get-color lay))
(not (vl-string-search "|" (vla-get-name lay))))
(progn (setq lays (cons (vla-get-name lay) lays))
(if (vla-get-lock lay)
(progn (setq lokt (cons (vla-get-name lay) lokt))
(vla-put-lock lay :vlax-false))))))
(vla-startundomark doc)
(setq lay (vla-add (vla-get-layers doc) layer))
(vla-put-color lay color)
(vlax-for
blk (vla-get-blocks doc)
(vlax-for
ent blk
(if (or (eq (vla-get-color ent) color) (member (vla-get-layer ent) lays))
(vla-put-layer ent layer))
(if (and (vlax-property-available-p ent "hasattributes")
(vla-get-hasattributes ent)
(setq atts (vlax-invoke ent "getattributes")))
(progn
(foreach
att atts
(if (or (eq (vla-get-color att) color) (member (vla-get-layer att)
lays))
(vla-put-layer att layer))
(vla-update att))))))
(if lokt
(foreach
lay lokt
(vla-put-lock (vla-item (vla-get-layers doc) lay) :vlax-true)))
(vla-endundomark doc)
(princ))

 

I think you can't use a wild card in that function. Just do first a list of all layers you need using the wild card, after, use your function COLOR2LAYER into the function FOREACH.

Gool luck !

 

Thats what I thought
Thanks

I can use this to get the list based on a color.
I have tried to modify it to look for a wild card
layer name also....no luck.

It must be for the same reason, you stated.

;;;Description: MKSxLayerColor was created to return a list of layers based on a
color
;;;Created by: Michael K. Sretenovic`
(defun MKSxLayerColor (color
;;variable - color to check
/ doc
;;variable - current drawing
lyr
;;variable - layer to check
lyrCol
;;variable - layer collection
;;ARCH#LAYL ;;variable - list of layers to return
)
(vl-load-com)
(setq doc (vla-get-activeDocument (vlax-get-acad-object))
lyrCol (vla-get-layers doc)
ARCH#LAYL ())
(vlax-for
lyr lyrCol
(if (= (vla-get-color lyr) color)
(setq ARCH#LAYL (append ARCH#LAYL (list (vla-get-name lyr))))))
ARCH#LAYL)


Gary

layers you need using the wild card, after, use your function COLOR2LAYER into
the function FOREACH.

 

What are you trying to do? Jeff's routine gets all layers that are the color specified and all objects on those layers, and changes them to the new layer.

Tim

 

Try this and see if it's what you want.

Tim

(defun c:ChangeLayerColor (/ Color Lay1 Lays ActDoc)

(setq Color (getint "\n Enter color number: "))
(setq Lay1 (strcase (getstring "\n Enter layer name to change: ")))
(if (and (/= Lay1 "") Color)
(progn
(setq ActDoc (vla-get-ActiveDocument (vlax-get-ACAD-Object)))
(vla-StartUndoMark ActDoc)
(setq Lays (vla-get-Layers ActDoc))
(if (vl-string-search "*" Lay1)
(vlax-for item Lays
(if (wcmatch (vla-get-Name item) Lay1)
(vla-put-Color item Color)
)
)
(vlax-for item Lays
(if (= Lay1 (vla-get-Name item))
(vla-put-Color item Color)
)
)
)
(vla-EndUndoMark ActDoc)
)
)
(princ)
)

 

I always forget to add the (vl-load-com) when posting, so you need to add it to work.

Tim

 

Gary,
if you want to change the color of layers within an Xref, this isn't the
lisp you want. Instead, see the thread "Making all x-refs show as colour 9
for checking...?" started on 5/2/2003......that should get you going.

 

You da man...works perfectly.
I will use this to repair of drawing files, where we changed our office standards
for poched walls from color 9 to color 8.

Thanks for your time and routine....it will be put to use.

Gary

 

Forgive my ignorance, but how do I get this past thread?
I have already tried the Find Message, with no luck.

Gary

 

Here is my modification to your routine...
Thanks again.

Gary

;;;by Tim Willey 2004
;;;usage (ARCH:ChangeLayerColor 8 "*|LS-1HF")
(defun ARCH:ChangeLayerColor (Color Layer / Lay1 Lays ActDoc)
(vl-load-com)
(setq Lay1 (strcase Layer))
(if (and (/= Lay1 "") Color)
(progn (setq ActDoc (vla-get-ActiveDocument (vlax-get-ACAD-Object)))
(vla-StartUndoMark ActDoc)
(setq Lays (vla-get-Layers ActDoc))
(if (vl-string-search "*" Lay1)
(vlax-for
item Lays
(if (wcmatch (vla-get-Name item) Lay1)
(vla-put-Color item Color)))
(vlax-for
item Lays
(if (= Lay1 (vla-get-Name item))
(vla-put-Color item Color))))
(vla-EndUndoMark ActDoc)))
(princ))

 

Hi Gary,
It appears that you are using Outlook Express to access the groups through
the nntp server. In OE, adjust the option under "Options/Read-News" to get
all of the groups headers (it defaults to get 300 at a time). On a slow
connection this will take a while, but to be able to search back through old
posts makes it worthwhile. And make sure to turn off any deletion of
messages that can be set in the Maintenance Tab of Options.

Doing this allows me to search through approx. 80,000 message headers, and
if I find what I'm looking for I can read it by selecting the header.

For this search, it may help to know that the thread was started by David
Penney.

 

Thanks

Gary

 

Could not get my Outlook to work....so just went up to AutoDesk's web site.
Are these the ones you were referring to? If so do you know if they have been
updated?

Thanks

Gary

;;; Routine to set all model space Xref layers to color 9
;;; by Jeff Mishler, 5/3/03
(defun C:XREFTO9 (/ ssblk cnt blknames lay ename)
(setq ssblk (ssget "x" '((0 . "INSERT") (410 . "Model"))))
(setq cnt 0)
(setq blknames "")
(repeat (sslength ssblk) ; create list of block names in Model space for
filter
list
(setq blknames (strcat blknames (cdr (assoc 2 (entget (ssname ssblk cnt))))
"|*,"))
(setq cnt (1+ cnt)))
(setq lay (tblnext "layer" t)) ;get layer entity
(command "undo" "be")
(while (/= lay nil)
(if (wcmatch (cdr (assoc 2 lay)) blknames) ;find xref layers, could use
assoc
70
instead
(progn (setq ename (tblobjname "layer" (cdr (assoc 2 lay))))
(setq lay (entget ename))
(if (> (cdr (assoc 62 lay)) 0) ; is the layer on?
(setq lay (subst (cons 62 9) (assoc 62 lay) lay)) ; yes it is
(setq lay (subst (cons 62 -9) (assoc 62 lay) lay)) ; no, it's off
)
(entmod lay)))
(setq lay (tblnext "layer")) ; next layer
)
(if ename
(prompt
"All xref layers in Model space (except \"0\" and \"defpoints\")
now color 9!")
(prompt "No xref layers found in Model Space!"))
(command "undo" "end")
(princ))







;;;R. Robert Bell, MCSE
(defun C:XRL ()
(vlax-For
Layer (vla-Get-Layers (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))
(if (wcmatch (vla-Get-Name Layer) "*|*")
(vla-Put-Color Layer 9)))
(princ))
;;;
(defun C:XRL (/ objDoc XRefs Layers)
(setq objDoc (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))
(vlax-For
Object (vla-Get-ModelSpace objDoc)
(if (vlax-Property-Available-P Object 'Path) ; simple test, should look at
ObjectName
too!
(setq XRefs (cons (vla-Get-Name Object) XRefs))))
(setq Layers (apply 'strcat
(cons (strcat (car XRefs) "|*")
(mapcar '(lambda (str) (strcat "," str "|*")) (cdr
XRefs)))))
(vlax-For
Layer (vla-Get-Layers objDoc)
(if (wcmatch (vla-Get-Name Layer) Layers)
(vla-Put-Color Layer 9)))
(princ))

 

Yes Gary, that is the thread I was referring to. I have not done anything
with that routine since then, and it doesn't do exactly what you originally
asked for. I was merely pointing you to it as it is a lot closer to what you
want than the one you first posted, and with some relatively minor
adjustments could be made to do what you desire.

 

Thanks again

Gary