Save tabs / layouts to dwg

I had a long research but now I found my own way to automate save any
layout/tab to a unique dwg file. The new created file contains only
the model wich is visible in the layout/tab. It also keeps settings
"freeze in current viewport" and it will delete all layouts/tabs
except for the saved layout/tab.

If anyone have another and even better sugestion, please reply...
I'm using Autocad 2002

Here you find the macro: (replace the drawingname and layout names
included the "<" and ">" !!!)

Macro works when the drawingfile is opened;

^C^C^Cfiledia 0 expert 3 save;;ctab <layoutname> mspace -layer set 0 a
s <layoutname>;;;;ctab <layoutname> mspace ^Ce all r w (getvar
"vsmin") (getvar "vsmax");;-layer a r <layoutname> ^C^Clo d
<layoutname to delete> lo d <second layoutname to delete and so on>
saveas;;<drawingname>.dwg -purge a;;n;pspace z e save;;filedia 1
expert 0 open;;

to repeat this macro, just copy the macro straight behind each other
and replace the drawingname and layout names!!

 

Now I wrote a lisp routine that works under all conditions, read below:

;written by ---)(---R. van de Burgt---)(---
;First this script asks for a input -> fileprefix, also you can press enter
;Saves each layout as an dwg file with the name of the layout
;Erases anything outside the viewport
;Each layout MUST have 1 viewport

(defun c:tabtoDwg (/ fn path msg msg2 fileprefix)
(defun DelAllLayouts (Keeper / TabName)
(vlax-for Layout
(vla-get-Layouts
(vla-get-activedocument (vlax-get-acad-object))
)
(if
(and
(/= (setq TabName (strcase (vla-get-name layout))) "MODEL")
(/= TabName (strcase Keeper))
)
(vla-delete layout)
)
)
)

(vl-load-com)
(setq msg "")
(setq msg2 "")
(command "._undo" "_BE")
(setq fileprefix (getstring "Give the fileprefix or press enter: "))
(foreach lay (layoutlist)
(if (/= lay "Model")
(progn
(command "_.undo" "_M")
(DelAllLayouts lay)
(setvar "tilemode" 0)
(command "mspace")
(command "-layer" "set" "0" "a" "s" "")
(command "erase" "all" "remove" "window" (getvar "vsmax") (getvar "vsmin") "")
(command "pspace")
(command "zoom" "extents")
(command "purge" "all" "" "n")
(setq path (getvar "DWGPREFIX"))
(setq fn (strcat path fileprefix lay ".dwg"))
(if (findfile fn)
(progn
(command ".-wblock" fn "_Y")
(if (equal 1 (logand 1 (getvar "cmdactive")))
(progn
(setq msg (strcat msg "\n" fn))
(command "*")
)
(setq msg2 (strcat msg2 "\n" fn))
)
)
(progn
(command ".-wblock" fn "*")
(setq msg (strcat msg "\n" fn))
)
)
(command "_.undo" "_B" "")
)
)
)
(if (/= msg "")
(progn
(prompt "\nFollowing drawings have been made:")
(prompt msg)
)
)
(if (/= msg2 "")
(progn
(prompt "\nFollowing drawings could not be made:")
(prompt msg2)
)
)
(command "._undo" "_E")
(textscr)
(princ)
)

 

So sorry, the previous one stops in the layer command, this one is fixed

;written by ---)(---R. van de Burgt---)(---
;First this script asks for a input -> fileprefix, also you can press enter
;Saves each layout as an dwg file with the name of the layout
;Erases anything outside the viewport
;Each layout MUST have 1 viewport

(defun c:tabnaarDwg (/ fn path msg msg2 fileprefix)
(defun DelAllLayouts (Keeper / TabName)
(vlax-for Layout
(vla-get-Layouts
(vla-get-activedocument (vlax-get-acad-object))
)
(if
(and
(/= (setq TabName (strcase (vla-get-name layout))) "MODEL")
(/= TabName (strcase Keeper))
)
(vla-delete layout)
)
)
)

(vl-load-com)
(setq msg "")
(setq msg2 "")
(command "._undo" "_BE")
(setq fileprefix (getstring "Give the fileprefix or press enter: "))
(foreach lay (layoutlist)
(if (/= lay "Model")
(progn
(command "_.undo" "_M")
(DelAllLayouts lay)
(setvar "tilemode" 0)
(command "mspace")
(command "-layer" "set" "0" "")
(command "erase" "all" "remove" "window" (getvar "vsmax") (getvar "vsmin") "")
(command "pspace")
(command "zoom" "extents")
(command "purge" "all" "" "n")
(setq path (getvar "DWGPREFIX"))
(setq fn (strcat path fileprefix lay ".dwg"))
(if (findfile fn)
(progn
(command ".-wblock" fn "_Y")
(if (equal 1 (logand 1 (getvar "cmdactive")))
(progn
(setq msg (strcat msg "\n" fn))
(command "*")
)
(setq msg2 (strcat msg2 "\n" fn))
)
)
(progn
(command ".-wblock" fn "*")
(setq msg (strcat msg "\n" fn))
)
)
(command "_.undo" "_B" "")
)
)
)
(if (/= msg "")
(progn
(prompt "\nDe volgende tekeningen zijn aangemaakt:")
(prompt msg)
)
)
(if (/= msg2 "")
(progn
(prompt "\nDe volgende tekeningen zijn niet aangemaakt:")
(prompt msg2)
)
)
(command "._undo" "_E")
(textscr)
(princ)
)