This is what I can ante up now.
It forces all to layer "0" except entities that were on "frozen" or "off" layers. Rather than delete the offending entities I opted to force them to two new layers, "FROZEN" or "OFF", so in the end you will have a drawing with potentially three layers "0", "FROZEN" and "OFF", as it purges all other layers, though absolute purging is not guaranteed in this version. For example, layers frozen in view ports will not be purged as the view port's xdata will reference the layers, preventing a purge. While that can easily be dealt with, as well as a suite of other layer purge inhibiting conditions, I simply don't have the time.
All entities will end up with hard coded color, line type and line weights corresponding to the layer they originally resided on. However, to perform the job correctly any objects with color or linetype "ByBlock" should inherit their properties from their parent's block (or parent block's layer). The program is coded so it branches on "ByBlock" accordingly, but in this version "ByBlock" is treated the same as "ByLayer", that is properties are inherited from the immediate parent layer.
Copy all the code, paste to a new text file and save as ForeceLayerZero.lsp to a folder in your support path. To load it type (load "ForceLayerZero"). To run it after it's loaded just type ForceLayerZero. Read the inline comments if you want to know more.
While it may look intimidating and / or appear to be a lot of code, it's neither. I have a verbose, modular coding style that makes it appear more than it is. Fear not, it's easy, simple sh*t.
;; Provided complete with errors and omissions, without warranty,
;; implied or stated for any particular use. USE AT YOUR OWN RISK.
(defun C:ForceLayerZero ( / _ChangeProperties _ItemExists _AddItem _Main )
(defun _ChangeProperties ( object layer_index frozen off / properties lineweight )
(setq properties
(cdr
(assoc
(vla-get-layer object)
layer_index
)
)
)
;; color
(cond
;; bylayer
( (eq 256 (vla-get-color object))
(vla-put-color
object
(cdr (assoc 'color properties))
)
)
;; byblock -- to do this properly the color
;; of the parent block (if there is one) should
;; be used (or the parent block's layer color if
;; the parent block is bylayer). Maybe in the
;; next version, for now treat same as bylayer.
( (zerop (vla-get-color object))
(vla-put-color
object
(cdr (assoc 'color properties))
)
)
)
;; linetype
(cond
;; bylayer
( (eq "ByLayer" (vla-get-linetype object))
(vla-put-linetype
object
(cdr (assoc 'linetype properties))
)
)
;; byblock -- to do this properly the linetype
;; of the parent block (if there is one) should
;; be used (or the parent block's layer linetype
;; if the parent block linetype is bylayer). Maybe
;; in the next version, for now treat same as bylayer.
( (eq "ByBlock" (vla-get-linetype object))
(vla-put-linetype
object
(cdr (assoc 'linetype properties))
)
)
)
;; lineweight
(if
(/=
(vla-get-lineweight object)
(setq lineweight (cdr (assoc 'lineweight properties)))
)
(vla-put-lineweight object lineweight)
)
;; map the entity to layer "FROZEN", "OFF" or "0"
(cond
( (minusp (cdr (assoc 'freeze properties)))
(vla-put-layer object frozen)
)
( (zerop (cdr (assoc 'layeron properties)))
(vla-put-layer object off)
)
( t
(vla-put-layer object "0")
)
)
)
(defun _ItemExists ( collection key / result )
(vl-catch-all-apply
'(lambda ( )
(vla-item collection key)
(setq result t)
)
)
result
)
(defun _AddItem ( collection prefix / key )
(if (_ItemExists collection prefix)
(setq key prefix)
( (lambda ( i )
(while
(_ItemExists collection
(setq key
(strcat
prefix
(itoa (setq i (1+ i)))
)
)
)
)
)
1000
)
)
(vla-add collection key)
)
(defun _Main ( document / layers layer_index frozen frozen_name off off_name )
(if (< 1 (vla-get-count (setq layers (vla-get-Layers document))))
(progn
;; unlock all layers and create
;; the layer property index
(vlax-for layer (setq layers (vla-get-Layers document))
(vla-put-Lock layer :vlax-false)
(setq layer_index
(cons
(cons
(vla-get-name layer)
(mapcar
'(lambda ( property )
(cons
property
(vlax-get layer property)
)
)
'(color linetype lineweight layeron freeze)
)
)
layer_index
)
)
)
;; make layer 0 active so we can
;; nuke all the other layers later
( (lambda ( layer )
(vla-put-layeron layer :vlax-true)
(if (/= "0" (getvar "clayer"))
(vla-put-freeze layer :vlax-false)
)
)
(vla-item layers "0")
)
(setvar "clayer" "0")
;; create 2 new layers, one will be called "FROZEN" the
;; other will be called "OFF". Place entities accordingly.
(setq
frozen (_AddItem layers "FROZEN")
frozen_name (vla-get-name frozen)
off (_AddItem layers "OFF")
off_name (vla-get-name off)
)
;; set the layer properties accordingly
(vla-put-freeze frozen :vlax-true)
(vla-put-layeron off :vlax-false)
;; now abuse every object in the drawing
(vlax-for block (vla-get-Blocks document)
(vlax-for object block
(_ChangeProperties object layer_index frozen_name off_name)
(if (eq "AcDbBlockReference" (vla-get-ObjectName object))
(foreach attrib
(append
(vlax-invoke object 'GetAttributes)
(vlax-invoke object 'GetConstantAttributes)
)
(_ChangeProperties object layer_index frozen_name off_name)
)
)
)
)
;; purge the bastard
(repeat 5 (vla-purgeall document))
;; if the frozen and off layers remain in the drawing
;; rename them if they don't sport the names we want
(if (null (vlax-erased-p frozen))
(if (/= "FROZEN" (strcase (vla-get-name frozen)))
(vla-put-name frozen "FROZEN")
)
)
(if (null (vlax-erased-p off))
(if (/= "OFF" (strcase (vla-get-name off)))
(vla-put-name off "OFF")
)
)
)
)
(princ)
)
;; do it, do it now
(_Main (vla-get-activedocument (vlax-get-acad-object)))
)