Block Colour Change for LISP

[Tbone123]

Hey

I was just wondering if anyone could give me a hand or a starting point to writing a routine that will open blocks in a drawing and change the colour.

We receive drawings from clients with their blocks and would like to have them changed to our company colours.

So basically, i am looking for something that would within a drawing, change every block to a specific color without exploding and redefining. The colour changes will be the same throughout new drawings

Regards

T

[Anonymous]

Can you do it by changing the color of a Layer or Layers?
--
Kent Cooper


wrote...
Hey

I was just wondering if anyone could give me a hand or a starting point to
writing a routine that will open blocks in a drawing and change the colour.

We receive drawings from clients with their blocks and would like to have
them changed to our company colours.

So basically, i am looking for something that would within a drawing, change
every block to a specific color without exploding and redefining. The
colour changes will be the same throughout new drawings

Regards

T

[Tbone123]

It doesnt seem to work that way, i guess because they are blocks, i seem to have to explode them, edit colour, then redefine

[Anonymous]

Just the fact that they're blocks wouldn't necessarily mean you need to do
that. If the elements of the block definition are drawn on Layer Zero,
without override colors assigned, all you would need to do would be to
change the layer the block insertions are on. If the elements are drawn on
other layers, without override colors, all you would have to do would be to
change the colors of those layers, assuming they're their layers and not
yours.

You would only need to do what you describe if the elements within the
blocks have override colors assigned. You could either change the colors
assigned, or make them all Bylayer and do the second half of the preceding
paragraph. I don't have anything myself, but I think you might find some
solutions if you search the Newsgroup.

--
Kent Cooper


wrote...
It doesnt seem to work that way, i guess because they are blocks, i seem to
have to explode them, edit colour, then redefine

[Tbone123]

Yes, i am aware of this. We get these blocks from our clients who are using an abundance of layers, so they do not just easily change over.

Thank you for the response!

[Anonymous]

; TIP1127.LSP: BCOLOR.LSP Change Block Color (c)1995, Dean Langmaid
; With some edits

;**********Routine to change the color of a block**********
(defun C:BCOLOR (/ CLR CNT CMD EN1 EN2 EG1 EG2 NAM SS1 YN)
(setq CMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
;---Get the block to modify---
(while (null EN1)
(setq EN1 (entsel "\nSelect block to modify: "))
(if EN1
(progn
(setq EN1 (car EN1)
EG1 (entget EN1)
)
(if (= (cdr (assoc 0 EG1)) "INSERT")
(redraw EN1 3)
(progn
(redraw EN1 3)
(setq EN1 nil)
(princ "\nItem selected is not a block.")
)
)
)

(princ "\nNothing selected. Try again.")
)
)
;---Check for layer change---
(initget "Yes No")
(setq YN (getkword "\nChange entities to layer 0 : "))
;---Check for color---
(while (null CLR)
(initget "? RED YELLOW GREEN CYAN BLUE MAGENTA WHITE BYLAYER BYBLOCK")
(setq CLR (getint "\nColor for entities/? for list/: ")
CLR (cond ((null CLR) 256)
((and (= (type CLR) 'INT) (< -1 CLR 257)) CLR)
((= CLR "?") (LSTCDS))
((= CLR "RED") 1)
((= CLR "YELLOW") 2)
((= CLR "GREEN") 3)
((= CLR "CYAN") 4)
((= CLR "BLUE") 5)
((= CLR "MAGENTA") 6)
((= CLR "WHITE") 7)
((= CLR "BYBLOCK") 0)
((= CLR "BYLAYER") 256)
(t (and (princ "\nBad value, try again.") nil))
))
)
;---Loop through entities in the block---
(setq NAM (cdr (assoc 2 EG1))
EN2 (cdr (assoc -2 (tblsearch "BLOCK" NAM)))
)
(PRBLK EN2 NAM)

(setvar "CMDECHO" CMD)
(princ)
)
;*******Subroutine to change color and layer********
(defun PRBLK (EN2 NAM)
(setq CNT 0)
(while EN2
(setq CNT (1+ CNT)
EG2 (entget EN2)
EN2 (entnext (cdr (assoc -1 EG2)))
)
(grtext -2 (strcat NAM " block entity # " (itoa CNT)))

;---Check for nested blocks---
(if (= (cdr (assoc 0 EG2)) "INSERT")
(progn
(setq NM2 (cdr (assoc 2 EG2))
EN3 (cdr (assoc -2 (tblsearch "BLOCK" NM2)))
)
(PRBLK EN3 NM2)
)

(progn
;---Check color---
(if (assoc 62 EG2)
(setq EG2 (subst (cons 62 CLR) (assoc 62 EG2) EG2))
(setq EG2 (append EG2 (list (cons 62 CLR))))
)
(entmod EG2)

;---Check layer---
(if (and (= YN "Yes") (/= (cdr (assoc 8 EG2)) "0"))
(progn
(setq EG2 (subst (cons 8 "0") (assoc 8 EG2) EG2))
(entmod EG2)
)
)
)
)
)
---Update all blocks in the drawing---
(setq SS1 (ssget "X" (list (cons 2 NAM)));find all insertions of that block, if any
CNT 0)
(if SS1 (progn
(setq C (- (sslength SS1) 1)) ; set counter
(while (>= C CNT) ; while entities in the list
(setq EN1 (ssname SS1 CNT))
(setq CNT (1+ CNT))
(entupd EN1)
);end while C
);progn
);if SS1
);defun

;********Subroutine to list the options*************
(defun LSTCDS ()
(if textpage (textpage) (textscr))
(princ "\n ")
(princ "\n Color number | Standard meaning ")
(princ "\n ________________|____________________")
(princ "\n | ")
(princ "\n 0 | ")
(princ "\n 1 | Red ")
(princ "\n 2 | Yellow ")
(princ "\n 3 | Green ")
(princ "\n 4 | Cyan ")
(princ "\n 5 | Blue ")
(princ "\n 6 | Magenta ")
(princ "\n 7 | White ")
(princ "\n 8...255 | -Varies- ")
(princ "\n 256 | ")
(princ "\n \n\n\n")
(getint "\nColor number: ")
)

(princ "\n\tLoaded BCOLOR.LSP. Type BCOLOR to begin.")
(princ); end bcolor.lsp

[Tbone123]

Wow, that is perfect, thank you so much!!

Really appreciate that!

T

[GavrielKing]

This routine works great!!! Do you happen to have one that I can use to select every block in a drawing (they all have different names and the colors of the entities are not bylayer, they have changed the color of the entity, not the layer) and make the colors bylayer?

[Anonymous]

Here a hack of the previous that will get everthing in a drawing. Be patient.


; CBL Change all entitities to color bylayer

;**********Routine to change the color of a block**********
(defun C:cbl (/ CNT CMD EN1 EN2 EG1 EG2 NAM SS1)
(setq CMD (getvar "CMDECHO"))
(setvar "CMDECHO" 1)

(load "ai_utils")

(setq blk_list (ai_table "block" 12)) ; no Xrefs or
; Xref dependents.
(if (>= (getvar "maxsort") (length blk_list)) ; Alphabetize if greater
(if blk_list (setq blk_list (acad_strlsort blk_list))) ; than maxsort.
)

(setq old_vp (getvar "cvport");save current viewport
old_tile (getvar "tilemode");save current tilemode
c_layer (getvar "layer")
old_expert (getvar "expert"));save current layr
(command "view" "s" "CBL")
(ddslayer);save current layer settings
(command "layer" "set" "0" "")
(setvar "cmdecho" 1);debug
(command "layer" "thaw" "*" "on" "*" "unlock" "*" "");thaw, on, unlock all

(setq rep 0)
(repeat (length blk_list) ;process block list
(BCBL (nth rep blk_list))
(setq rep (+ 1 rep))
)

(COMMAND "change" "all" "" "p" "c" "bylayer" "")

;restore commands here

(command "zoom" "e")
(ddrlayer) ;restore layer settings
(command "layer" "set" c_layer "");set back to original layer
(command "view" "r" "CBL")
(setvar "attreq" old_attreq)
(setvar "expert" old_expert)
(prin1)
(princ "\n\tLoaded CBL.LSP. Type CBL to begin.")
(princ)
); end

;layer setting save routine
(defun ddslayer ()
(setq
c_lay (getvar "clayer")
lay_set_list nil
layer_name (tblnext "layer" "T")
)
(while layer_name
(setq lay_set (get_set layer_name))
(setq layer_list (append layer_list (list lay_set)))
(setq layer_name (tblnext "layer"))
)
)
;-----------------------------------------------------
; BIT SET
;-----------------------------------------------------
(defun BITSET (A B) (= (boole 1 A B) B))
;-----------------------------------------------------
; DXFGET
;-----------------------------------------------------
(defun DXFGET (A B) (cdr (assoc A B)))
;-----------------------------------------------------
; Get layer settings
;-----------------------------------------------------
(defun get_set (LAYER)
(if LAYER
(list
(> (DXFGET 62 LAYER) 0) ;negative if off
(bitset (DXFGET 70 LAYER) 1) ;set if frozen
(bitset (DXFGET 70 LAYER) 4) ;set if locked
(DXFGET 2 LAYER) ;layer name
)
)
)

(defun ddrlayer() ;layer restore routine
(command "regenauto" "off")
(setq rep 0)
(command ".layer")
(repeat (length layer_list)
(setq t_layer (nth rep layer_list)
l_name (cadddr t_layer)
)
(command
(if (car t_layer) "on" "off") l_name)
(command
(if (cadr t_layer) "freeze" "thaw") l_name)
(command
(if (caddr t_layer) "lock" "unlock") l_name)
(setq rep (+ 1 rep))
)
(command "")
)
(princ)
(prompt "\n\t\tStart with 'CBL'")(prin1)
;end





;---Loop through entities in the block---
(defun BCBL (NAM)


(SETQ EN2 (cdr (assoc -2 (tblsearch "BLOCK" NAM)))
)
(PRBLK EN2 NAM)
(setvar "CMDECHO" CMD)
(princ)
)

;*******Subroutine to change color and layer********
(defun PRBLK (EN2 NAM)
(setq CNT 0)
(while EN2
(setq CNT (1+ CNT)
EG2 (entget EN2)
EN2 (entnext (cdr (assoc -1 EG2)))
)
(grtext -2 (strcat NAM " block entity # " (itoa CNT)))
;---Check color---
(if (assoc 62 EG2)
(setq EG2 (subst (cons 62 256) (assoc 62 EG2) EG2))
(setq EG2 (append EG2 (list (cons 62 256))))
)
(entmod EG2)
;---Set to layer 0---

(if (/= (cdr (assoc 8 EG2)) "0")
(progn
(setq EG2 (subst (cons 8 "0") (assoc 8 EG2) EG2))
(entmod EG2)
)
)
;---Check for nested blocks---
(if (= (cdr (assoc 0 EG2)) "INSERT")
(progn
(setq NM2 (cdr (assoc 2 EG2))
EN3 (cdr (assoc -2 (tblsearch "BLOCK" NM2)))
)
(PRBLK EN3 NM2)
)
);endif
)
---Update all blocks in the drawing---
(setq SS1 (ssget "X" (list (cons 2 NAM)));find all insertions of that block, if any
CNT 0)
(if SS1 (progn
(setq C (- (sslength SS1) 1)) ; set counter
(while (>= C CNT) ; while entities in the list
(setq EN1 (ssname SS1 CNT))
(setq CNT (1+ CNT))
(entupd EN1)
);end while C
);progn
);if SS1
);defun

wrote in message news:5175854@discussion.autodesk.com...
This routine works great!!! Do you happen to have one that I can use to select every block in a drawing (they all have
different names and the colors of the entities are not bylayer, they have changed the color of the entity, not the
layer) and make the colors bylayer?

[GavrielKing]

Cool! Thanks!

[GavrielKing]

Do you happen to have one that will do this to architectural desktop entities when using Acad 2006? Or do you have any suggestions on how I can accomplish this, even if I have to explode the entities. Because when I explode the entities, all the "formatting" gets lost and things don't show up as intended.

[Anonymous]

The only way we have been able to handle them is to use the utilities in ADT. The lack of backward file compatibility
is a constant source of grief.

[GavrielKing]

Ok. Thanks.

[Anonymous]

That's awesome! Thank you! I am looking for a routine that will change an xref'd dimension text color to a color instead of it retaining its parent "byblock" color.

I xref the drawing into mine for plotting, and the color used is too think for the scale i need. I want to avoid exploding it, or copying since I need it to update as its updated in the parent.

[Anonymous]

Hi

Your LISP is perfect. but I need to ask a question?

I dont want to change the color for all block drawing. just only yellow colored drawings. is it possible to change yellow ones to add new codes into your LISP

many thanks

Emin.