Find every color used in drawing.

I'm trying to write a routine that will find ever color used on all entities including layers and entities within blocks.
I've been doing some searching but I can't get the colors of entities within blocks. Can anyone help me out?
Thanks
This is what I have (also attached):
(defun c:findcolors (/ ents ent_length ent
color_list new_color lyr
)
(setq color_list '())

(while (setq lyr (tblnext "layer" (not lyr)))

(setq new_color (abs (cdr (assoc 62 lyr))))

(if (not (member new_color color_list))

(setq color_list (cons new_color color_list))

);if

);while

(setq ent (entnext))

(while (/= ent 'nil)

(if (/= (setq new_color (cdr (assoc 62 (entget ent)))) nil)

(if (not (member new_color color_list))

(setq color_list (cons new_color color_list))

);if

);if

(setq ent1 ent
ent (entnext ent1))

);while

(princ color_list)

(print)

);defun

 

Hi Tomdum

Try this one:

Code:

(defun C:FindColors ( / ColLst CurEnt CurSet TblItm)
;Processing block references...
(while (setq TblItm (tblnext "BLOCK" (not TblItm)))
(setq CurEnt (cdr (assoc -2 TblItm)))
(while CurEnt
(setq ColLst (MeAddColor2List (entget CurEnt) 62 ColLst)
CurEnt (entnext CurEnt)
)
(princ "\rProcessing color search... ")
(MeDoSpin)
)
)
;Processing dimstyles...
(setq TblItm nil)
(while (setq TblItm (tblnext "DIMSTYLE" (not TblItm)))
(foreach memb '(176 177 178)
(setq ColLst (MeAddColor2List TblItm memb ColLst))
(princ "\rProcessing color search... ")
(MeDoSpin)
)
)
;Processing layers...
(setq TblItm nil)
(while (setq TblItm (tblnext "LAYER" (not TblItm)))
(setq ColLst (cons (abs (cdr (assoc 62 TblItm))) ColLst))
(princ "\rProcessing color search... ")
(MeDoSpin)
)
;Processing entities...
(if (setq CurSet (ssget "X"))
(while (setq CurEnt (ssname CurSet 0))
(setq ColLst (MeAddColor2List (entget CurEnt) 62 ColLst))
(ssdel CurEnt CurSet)
(princ "\rProcessing color search... ")
(MeDoSpin)
)
)
(princ "\n")
(princ (vl-sort ColLst '<))
(print)
)
;
; == Function MeAddColor2List
; Adds a color field to a list.
; Arguments [Type]:
;   Ent = Entity list [LIST]
;   Key = DXF key for color field [INT]
;   Cls = Color list [LIST]
; Return [Type]:
;   > Color list [LIST]
; Notes:
;   - Exclude ByLayer and ByBlock
;
(defun MeAddColor2List (Ent Key Cls / NewCol TmpLst)
(setq TmpLst Cls)
(cond
((not (setq NewCol (cdr (assoc Key Ent)))))
((member NewCol '(0 256)))
((setq TmpLst (cons NewCol TmpLst)))
)
TmpLst
)
;
; == Function MepDoSpin
; Writes a spinning wheel to the command line.
; Arguments [Type]:
;   --- =
; Return [Type]:
;   > Null
; Notes:
;   None
;
(defun MeDoSpin ()
(setq Me:Prp (cond
((eq Me:Prp "|") (princ "/"))
((eq Me:Prp "/") (princ "-"))
((eq Me:Prp "-") (princ "\\"))
((eq Me:Prp "\\") (princ "|"))
((princ "|"))
)
)
(princ)
)

Cheers

 

Thanks!

 

Welcome...¦-)

Cheers