Save-as Macro for lots of formats?
Save-as Macro for lots of formats?
(OP)
As a final delivery for one of my clients, I have to export 12 different formats into a folder, which I then zip and send off. Currently, I have macros for save-as pdf and dxf, but do the rest by hitting save-as, navigating to my chosen folder then picking the format I want and saving. Bit slow if I have several parts to deliver...
Would it be possible to create a macro to save-as all the formats requested to a specified folder?
The formats they request are: (1-5 for drawing, 6-12 for part)
1 .dwg
2 .dxf
3 .edrw
4 .pdf
5 .slddrw
6 .eprt
7 .igs
8 .sat
9 .sldprt
10 .step
11 .wrl
12 .x_t
Thanks,
Tom.
Would it be possible to create a macro to save-as all the formats requested to a specified folder?
The formats they request are: (1-5 for drawing, 6-12 for part)
1 .dwg
2 .dxf
3 .edrw
4 .pdf
5 .slddrw
6 .eprt
7 .igs
8 .sat
9 .sldprt
10 .step
11 .wrl
12 .x_t
Thanks,
Tom.






RE: Save-as Macro for lots of formats?
.dxf
.dwg
.pdf
.step
.jpg
I know its not all 12, but its a start.
RE: Save-as Macro for lots of formats?
http://www.lennyworks.com/solidworks/default.asp?I...
I have had recent issues with SW2012-64bit... but it still works. Can export all filetypes you list... I believe. Will do this on a directory of files, but lets you select within the directory.
-Dustin
Professional Engineer
Pretty good with SolidWorks
RE: Save-as Macro for lots of formats?
-Dustin
Professional Engineer
Pretty good with SolidWorks
RE: Save-as Macro for lots of formats?
RE: Save-as Macro for lots of formats?
RE: Save-as Macro for lots of formats?
RE: Save-as Macro for lots of formats?
-Dustin
Professional Engineer
Pretty good with SolidWorks
RE: Save-as Macro for lots of formats?
RE: Save-as Macro for lots of formats?
We reuse the same button for different purpouse if it is a drawing or a Part file and SaveDwgPDF is the one i call most from my button menu.
CODE --> vba
Option Explicit Public Enum eSaveAsType esaSTEP = 1 esaPDF = 2 esaDWG = 4 esaDXF = 8 esaEDRW = 16 esaPARA = 32 esa3DXML = 64 esaJPG = 128 esaJPGZA = 256 esaIGES = 512 End Enum Sub SaveJpegZoomAll() SaveAsMulti esaJPGZA End Sub Sub SaveJpegZoomed() SaveAsMulti esaJPG End Sub Sub SaveSTEP() SaveAsMulti esaSTEP End Sub Sub SaveEDrawing() SaveAsMulti esaEDRW End Sub Sub SaveDwgPDF() Dim swApp As SldWorks.SldWorks Dim swModel As SldWorks.ModelDoc2 Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc Select Case swModel.GetType Case swDocPART SaveAsMulti esaSTEP + esa3DXML + esaEDRW, True, False Case swDocDRAWING SaveAsMulti esaPDF + esaDWG, True, False Case swDocASSEMBLY SaveAsMulti esaSTEP + esa3DXML + esaEDRW, True, False Case Else End Select End Sub Sub SaveDwg() Dim swApp As SldWorks.SldWorks Dim swModel As SldWorks.ModelDoc2 Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc Select Case swModel.GetType Case swDocPART SaveAsMulti esaSTEP + esaEDRW, True, False Case swDocDRAWING SaveAsMulti esaDWG, True, False Case swDocASSEMBLY SaveAsMulti esaSTEP + esaEDRW, True, False Case Else End Select End Sub Sub SavePDF() SaveAsMulti esaPDF End Sub Sub SaveAsMulti(eFormat As eSaveAsType, Optional bCloseQuery As Boolean = False, Optional bEnumerate As Boolean = True) Dim swApp As SldWorks.SldWorks Dim swModel As SldWorks.ModelDoc2 Dim sBasePathName As String Dim sExt As String Dim ExistingFile As String Dim nErrors As Long Dim nWarnings As Long Dim nRetval As Long Dim bShowMap As Boolean Dim bRet As Boolean Dim iRet As Integer Dim iLoop As Integer Dim x As Integer Dim val As Long Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc GetAstonID sBasePathName = swModel.GetPathName If sBasePathName = "" Then swApp.SendMsgToUser2 "Inget dokument öppet eller fil ej sparad ännu.", swMbStop, swMbOk Else sBasePathName = Left(sBasePathName, Len(sBasePathName) - 6) bRet = True iLoop = 1 Do Select Case swModel.GetType Case swDocPART Select Case (iLoop And eFormat) Case esaSTEP sExt = "step" Case esaPDF sExt = "pdf" Case esaDWG sExt = "dwg" Case esaDXF sExt = "dxf" Case esaEDRW sExt = "eprt" Case esaPARA sExt = "x_b" Case esa3DXML sExt = "3dxml" Case esaJPG sExt = "jpg" Case esaJPGZA sExt = "jpg" Case esaIGES sExt = "igs" Case Else sExt = "" End Select Case swDocASSEMBLY Select Case (iLoop And eFormat) Case esaSTEP sExt = "step" Case esaPDF sExt = "pdf" Case esaDWG sExt = "dwg" Case esaDXF sExt = "dxf" Case esaEDRW sExt = "easm" Case esaPARA sExt = "x_b" Case esa3DXML sExt = "3dxml" Case esaJPG sExt = "jpg" Case esaJPGZA sExt = "jpg" Case esaIGES sExt = "igs" Case Else sExt = "" End Select Case swDocDRAWING Select Case (iLoop And eFormat) Case esaSTEP sExt = "" Case esaPDF sExt = "pdf" Case esaDWG sExt = "dwg" Case esaDXF sExt = "dxf" Case esaEDRW sExt = "edrw" Case esaPARA sExt = "" Case esa3DXML sExt = "" Case esaJPG sExt = "jpg" Case esaJPGZA sExt = "jpg" Case esaIGES sExt = "" Case Else sExt = "" End Select Case Else sExt = "" End Select If sExt <> "" Then If bEnumerate Then x = 0 Do x = x + 1 ExistingFile = Dir(sBasePathName & x & "." & sExt) Loop While ExistingFile <> "" End If If sExt = "jpg" Then If iLoop = esaJPGZA Then swModel.ActiveView.FrameState = 1 swModel.ViewZoomtofit2 End If val = swApp.GetUserPreferenceIntegerValue(swSystemColorsViewportBackground) swApp.SetUserPreferenceIntegerValue swSystemColorsViewportBackground, &HFFFFFF ' white If bEnumerate Then swModel.SaveAs2 sBasePathName & x & "." & sExt, 0, True, False Else swModel.SaveAs2 sBasePathName & sExt, 0, True, False End If swApp.SetUserPreferenceIntegerValue swSystemColorsViewportBackground, val ' colored Else HideAstonStamp If bEnumerate Then bRet = bRet And swModel.SaveAs4(sBasePathName & x & "." & sExt, swSaveAsCurrentVersion, swSaveAsOptions_Silent, nErrors, nWarnings) Else bRet = bRet And swModel.SaveAs4(sBasePathName & sExt, swSaveAsCurrentVersion, swSaveAsOptions_Silent, nErrors, nWarnings) End If ShowAstonStamp End If End If iLoop = iLoop * 2 Loop While iLoop <= 512 If bRet = False Then swApp.SendMsgToUser2 "Problems saving file.", swMbWarning, swMbOk Else If bCloseQuery Then iRet = swApp.SendMsgToUser2("File exported, Save and close?", swMbInformation, swMbYesNo) If iRet = swMbHitYes Then swModel.Save swApp.CloseDoc swModel.GetPathName End If End If End If End If End Sub