每个层单独保存DWG文件

Lisphk

;; Layers to Drawings  -  Lee Mac  -  2011  -  [url]www.lee-mac.com[/url]
;; WBlocks objects on each layer in a drawing to separate drawing files.

(defun c:lay2dwg ( / _UniqueFilename acdoc acsel fpath typevar )

    (defun _UniqueFilename ( seed / f i )
        (setq i 1)
        (if (findfile (setq f (strcat seed ".dwg")))
            (while (findfile (setq f (strcat seed "(" (itoa (setq i (1+ i))) ").dwg"))))
        )
        f
    )

    (defun _UniqueItem ( collection seed / i )
        (setq i 1)
        (while
            (null
                (vl-catch-all-error-p
                    (vl-catch-all-apply 'vla-item
                        (list collection (strcat seed (itoa (setq i (1+ i)))))
                    )
                )
            )
        )
        (strcat seed (itoa i))
    )

    (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
          acsel (vla-get-selectionsets acdoc)
          acsel (vla-add acsel (_UniqueItem acsel "lay2dwg"))
          fpath (strcat (getvar 'DWGPREFIX) (cadr (fnsplitl (getvar 'DWGNAME))) "_")
    )
    (vla-clear acsel)
    (setq typevar
        (vlax-make-variant
             (vlax-safearray-fill
                 (vlax-make-safearray vlax-vbinteger '(0 . 1)) '(8 410)
             )
        )
    )
    (vlax-for layer (vla-get-layers acdoc)
        (vla-select acsel acselectionsetall nil nil typevar
            (vlax-make-variant
                (vlax-safearray-fill
                    (vlax-make-safearray vlax-vbvariant '(0 . 1)) (list (vla-get-name layer) "Model")
                )
            )
        )
        (if (< 0 (vla-get-count acsel))
            (progn
                (vla-wblock acdoc (_UniqueFilename (strcat fpath (vla-get-name layer))) acsel)
                (vla-clear acsel)
            )
        )
    )
    (vla-delete acsel)
    (princ)
)
(vl-load-com) (princ)

xvjiex

感谢分享每个层单独保存DWG文件