;;; ---------------------------------------------------------------------------
;;; LayerSplit.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Exports the contents of every layer to its own separate drawing file.
;;;
;;; You choose an output folder, and one DWG is written per layer, named
;;; <sourceDrawing>_<layerName>.dwg. Empty layers are reported and skipped.
;;;
;;; Typical uses are splitting a combined model out for individual consultants,
;;; extracting a single discipline from a merged drawing, or breaking an
;;; inherited monster file into something manageable.
;;;
;;; WHICH LAYERS ARE PROCESSED
;;; Layers that are switched OFF are skipped, on the basis that they were
;;; turned off deliberately and are not wanted in the output. Xref-dependent
;;; layers - those with a "|" in the name - are also skipped, since their
;;; content belongs to the referenced drawing rather than to this one.
;;;
;;; FILENAME COLLISIONS ARE HANDLED
;;; If a target filename already exists, a numeric suffix is added - _(1), _(2)
;;; and so on - so an existing export is never silently overwritten. That
;;; matters, because running this twice into the same folder is an easy thing
;;; to do by accident.
;;;
;;; The source drawing is NOT modified. WBLOCK writes copies out; nothing is
;;; removed from the drawing you are working in, which is why this routine
;;; opens no undo group - there is nothing to undo.
;;;
;;;   LAYERSPLIT  - export each layer to its own drawing
;;; ---------------------------------------------------------------------------

(vl-load-com)

;; ---------------------------------------------------------------------------
;; LayerSplit:UniqueFilename
;; ---------------------------------------------------------------------------
;; Returns a .dwg path that does not yet exist, appending (1), (2) ... to the
;; supplied stem until a free name is found.
;; ---------------------------------------------------------------------------
(defun LayerSplit:UniqueFilename ( seed / idx filename )
    (setq idx 1)
    (if (findfile (setq filename (strcat seed ".dwg")))
        (while (findfile (setq filename (strcat seed "(" (itoa (setq idx (1+ idx))) ").dwg"))))
    )
    filename
)

;; ---------------------------------------------------------------------------
;; LayerSplit:ItemExists
;; ---------------------------------------------------------------------------
;; Returns the named item from a COM collection, or nil if it is absent.
;;
;; The catch is essential: asking a collection for an item it does not hold
;; throws rather than returning nil, so this is the only safe way to test.
;; ---------------------------------------------------------------------------
(defun LayerSplit:ItemExists ( coll item )
    (if (not (vl-catch-all-error-p
                 (setq item (vl-catch-all-apply 'vla-item (list coll item)))
             )
        )
        item
    )
)

;; ---------------------------------------------------------------------------
;; LayerSplit:UniqueName
;; ---------------------------------------------------------------------------
;; Returns a name not already used in the given collection, by appending an
;; incrementing number to the seed. Used to create a temporary selection set
;; without colliding with one that already exists in the document.
;; ---------------------------------------------------------------------------
(defun LayerSplit:UniqueName ( collection seed / idx )
    (setq idx 0)
    (while (LayerSplit:ItemExists collection (strcat seed (itoa (setq idx (1+ idx))))))
    (strcat seed (itoa idx))
)

;; ---------------------------------------------------------------------------
;; LayerSplit:Layers
;; ---------------------------------------------------------------------------
;; Returns the names of every layer eligible for export - see the header for
;; which are excluded and why.
;; ---------------------------------------------------------------------------
(defun LayerSplit:Layers ( doc / result )
    (vlax-for layer (vla-get-layers doc)
        (if (not (or (= :vlax-false (vla-get-layeron layer))
                     (wcmatch (vla-get-name layer) "*|*")
                 )
            )
            (setq result (cons (vla-get-name layer) result))
        )
    )
    (reverse result)
)

;; ---------------------------------------------------------------------------
;; LayerSplit:SafearrayVariant
;; ---------------------------------------------------------------------------
;; Wraps a list of values as a populated safearray variant of the given type.
;; ActiveX selection filtering requires its arguments in this form.
;; ---------------------------------------------------------------------------
(defun LayerSplit:SafearrayVariant ( datatype data )
    (vlax-make-variant
        (vlax-safearray-fill
            (vlax-make-safearray datatype (cons 0 (1- (length data))))
            data
        )
    )
)

;; ---------------------------------------------------------------------------
;; LayerSplit:FilterVariants
;; ---------------------------------------------------------------------------
;; Converts a DXF filter list into the paired type and value variants that
;; vla-Select expects, assigning them to the two supplied symbols.
;;
;; lst  - [list] DXF filter, e.g. ((8 . "MyLayer"))
;; *typ - [sym]  quoted symbol to receive the group-code variant
;; *val - [sym]  quoted symbol to receive the value variant
;; ---------------------------------------------------------------------------
(defun LayerSplit:FilterVariants ( lst *typ *val )
    (set *typ (LayerSplit:SafearrayVariant vlax-vbInteger (mapcar 'car lst)))
    (set *val
        (LayerSplit:SafearrayVariant vlax-vbVariant
            (mapcar
                (function
                    (lambda ( data )
                        (if (listp (setq data (cdr data)))
                            (vlax-3D-point data)
                            (vlax-make-variant data)
                        )
                    )
                )
                lst
            )
        )
    )
)

;; ---------------------------------------------------------------------------
;; LayerSplit:FolderDialog
;; ---------------------------------------------------------------------------
;; Displays the Windows folder browser and returns the chosen path without a
;; trailing backslash, or nil if cancelled.
;;
;; The Shell COM object is released explicitly - and so are the two child
;; objects obtained from the result - because a COM object left unreleased
;; stays in memory for the remainder of the AutoCAD session.
;;
;; msg  - [str] prompt shown at the top of the dialog
;; dir  - [str] initial folder, or nil
;; flag - [int] bit-coded dialog options
;; ---------------------------------------------------------------------------
(defun LayerSplit:FolderDialog ( msg dir flag / acad shell hwnd folder self path )
    (setq acad   (vlax-get-acad-object)
          shell  (vla-getInterfaceObject acad "Shell.Application")
          hwnd   (vl-catch-all-apply 'vla-get-HWND (list acad))
          folder (vlax-invoke-method shell 'BrowseForFolder
                     (if (vl-catch-all-error-p hwnd) 0 hwnd)
                     msg flag dir
                 )
    )
    (vlax-release-object shell)

    (if folder
        (progn
            (setq self (vlax-get-property folder 'Self)
                  path (vlax-get-property self 'Path)
            )
            (vlax-release-object self)
            (vlax-release-object folder)

            ;; Strip a trailing backslash, which the dialog returns for a drive
            ;; root - otherwise the path would end up with two.
            (if (= "\\" (substr path (strlen path)))
                (setq path (substr path 1 (1- (strlen path))))
            )
        )
    )
    path
)

;; ---------------------------------------------------------------------------
;; c:LAYERSPLIT  -  main routine
;; ---------------------------------------------------------------------------
(defun c:LAYERSPLIT ( / *error* vars vals doc docname sets path sel
                        typ val written skipped )

    (setq vars '("CMDECHO")
          vals (mapcar 'getvar vars)
    )

    (defun LayerSplit:Restore ( )
        ;; The temporary selection set must be deleted however the routine
        ;; exits, or it persists in the document as invisible clutter.
        (if sel
            (vl-catch-all-apply 'vla-delete (list sel))
        )
        (mapcar 'setvar vars vals)
        (princ)
    )

    (defun *error* ( msg )
        (LayerSplit:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** LAYERSPLIT error: " msg " **"))
        )
        (princ)
    )

    (setvar "CMDECHO" 0)

    (setq doc     (vla-get-activedocument (vlax-get-acad-object))
          docname (vl-filename-base (vla-get-name doc))
          sets    (vla-get-selectionsets doc)
          written 0
          skipped 0
    )

    (if (setq path (LayerSplit:FolderDialog "Select the folder for the new drawings" nil 0))
        (progn
            (setq sel (vla-add sets (LayerSplit:UniqueName sets "LayerSplit")))

            (foreach layer (LayerSplit:Layers doc)
                ;; Select everything on this layer, across the whole drawing.
                (LayerSplit:FilterVariants (list (cons 8 layer)) 'typ 'val)
                (vla-select sel acSelectionSetAll nil nil typ val)

                (if (zerop (vla-get-count sel))
                    (progn
                        (princ (strcat "\n  [ nothing on layer: " layer " ]"))
                        (setq skipped (1+ skipped))
                    )
                    (progn
                        (vla-wblock doc
                            (LayerSplit:UniqueFilename
                                (strcat path "\\" docname "_" layer)
                            )
                            sel
                        )
                        (princ (strcat "\n  --> exported layer: " layer))
                        (setq written (1+ written))
                    )
                )

                ;; Cleared, not deleted - the same set object is reused for
                ;; every layer, which avoids creating and destroying one per
                ;; layer on a drawing with hundreds of them.
                (vla-clear sel)
            )

            (princ (strcat "\n\n" (itoa written)
                           " drawing" (if (= 1 written) "" "s") " written to " path
                   )
            )
            (if (< 0 skipped)
                (princ (strcat "\n" (itoa skipped)
                               " empty layer" (if (= 1 skipped) "" "s") " skipped."
                       )
                )
            )
        )
        (princ "\n*Cancelled* - no output folder chosen.")
    )

    (LayerSplit:Restore)
    (princ)
)

(princ)