I have an ongoing issue with a few South American customers, who like the color yellow, probably because they use a black background for their CAD station. The main issue is that they often color entities inside a block by explicitly assigning that color, rather than using Bylayer.

I have tried 4 different LISP or VBA routines that I have found on the Internet that should change the objects inside a block to be layer 0 and colored bylayer. But, none of them have worked on my v14 Platinum. I have also searched the Bricsys application catalog without success.

Does anyone know of a program that is compatible with BricsCAD, that can accomplish what I want?

Thanks for any suggestions.
-Joe

For reference, here are two of the LISP programs I found, that didn't work

;;  BlockSParts0Bylayer.lsp
;;  = change all Parts of definitions of Selected Block(s) [other
;;    than on Layer Defpoints] to Layer 0 with Color ByLayer
;;  Kent Cooper, last edited 4 November 2014

(vl-load-com)
(defun C:BP0B (/ *error* doc nametolist blkss inc blk blknames ent edata obj)
princ ("Type BP0B to start command.  Note the 0 is a ZERO")
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))

    ); if
    (vla-endundomark doc)
    (princ)
  ); defun - *error*

  (defun nametolist (blk / blkobj blkname); get Block name and put it into list of names
    (if (= (logand (cdr (assoc 70 (entget blk))) 4) 0) ; not an Xref
      (progn
        (setq
          blkobj (vlax-ename->vla-object blk)
          blkname
            (vlax-get-property blkobj
              (if (vlax-property-available-p blkobj 'EffectiveName) 'EffectiveName 'Name)
                ; to work with older versions that don't have dynamic Blocks
            ); ...get-property & blkname
        ); setq
        (if
          (not (member blkname blknames)); name not already in list
          (setq blknames (append blknames (list blkname))); then -- add to end of list
        ); if
      ); progn
    ); if
  ); defun -- nametolist

  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc); = Undo Begin

  (if (setq blkss (ssget '((0 . "INSERT")))); User selection of any number of Blocks/Minserts/Xrefs
    (progn ; then
      (repeat (setq inc (sslength blkss)); get names from initial selection
        (setq blk (ssname blkss (setq inc (1- inc))))
        (nametolist blk)
      ); repeat
      (while (setq blk (car blknames)); as long as there's another Block name in list
        ;; done this way instead of via (repeat) or (foreach), so it can add nested Blocks' names to list
        (setq ent (tblobjname "block" blk)); Block definition as entity
        (while (setq ent (entnext ent)); then -- proceed through sub-entities in definition
          (setq edata (entget ent))
          (if (member '(0 . "INSERT") edata) (nametolist ent)); if nested Block, add name to end of list
          (if (not (member '(8 . "Defpoints") edata)); process all entities NOT on Layer Defpoints
            (progn
              (setq obj (vlax-ename->vla-object ent))
              (vla-put-layer obj "0"); to Layer 0
              (vla-put-color obj 256); color ByLayer
              (if (wcmatch (vla-get-ObjectName obj) "*Dimension,*Leader")
                (foreach prop '(DimensionLineColor ExtensionLineColor TextColor)
                  ;; not all such entity types have all 3 properties, but all have at least one
                  (if (vlax-property-available-p obj prop)
                    (vlax-put obj prop 256); ByLayer
                  ); if
                ); foreach
              ); if
            ); progn
          ); if
        ); while -- sub-entities
        (setq blknames (cdr blknames)); take first one off
      ); while
      (command "_.regen")
    ); progn
    (prompt "\nNo Block(s) selected.")
  ); if [user selection]

  (vla-endundomark doc); = Undo End
  (princ)
); defun

==================================================

PROGRAM NUMBER TWO

==================================================

;FixBlock.lsp [June 30, 1998]
;
; Copyright 1996 - 1998 ManuSoft
;
; Freeware from:
; ManuSoft
; http://www.manusoft.com
;
; Redefines all or selected blocks so that all entities are on
; layer '0' (zero), with color 'BYBLOCK'.
;
; Load function, then enter FIXBLOCK to redefine selected blocks
; so that all entities are on layer '0', color 'BYBLOCK'.
;

(defun C:FixBlock (/ ss cnt idx blkname donelist Grp Update)
(defun Grp (gc el) (cdr (assoc gc el)))
(defun Update (bname / ename elist)
(setq ename (tblobjname "BLOCK" bname))
(if
(and ename (zerop (logand 52 (Grp 70 (entget ename '(""))))))
(progn
(while ename
(setq elist (entget ename '(""))
elist (subst '(8 . "0") (assoc 8 elist) elist)
elist (if (assoc 62 elist)
(subst '(62 . 0) (assoc 62 elist) elist)
(append elist '((62 . 0)))))
(entmake elist)
(setq ename (entnext ename)))
(if (/= "ENDBLK" (Grp 0 elist))
(entmake '((0 . "ENDBLK") (8 . "0") (62 . 0))))
'T))
)
(if (> (logand (Grp 70 (tblsearch "layer" "0")) 1) 0)
(princ "\nLayer 0 must be thawed before running FIXBLOCK!\n")
(progn
(if
(progn
(princ "\nPress to fix all defined blocks\n")
(setq cnt 0
ss (ssget '((0 . "INSERT")))))
(progn
(setq idx (sslength ss))
(while (>= (setq idx (1- idx)) 0)
(if (not (member (setq blkname (Grp 2 (entget (ssname ss idx)))) donelist))
(progn
(if (Update blkname) (setq cnt (1+ cnt)))
(setq donelist (cons blkname donelist))))))
(while (setq blkname (Grp 2 (tblnext "BLOCK" (not blkname))))
(if (Update blkname) (setq cnt (1+ cnt)))))
(princ (strcat "\n" (itoa cnt) " block" (if (= cnt 1) "" "s") " redefined\n"))))
(princ)
)
;End-of-file