Save-as Macro for lots of formats? 1

[hititfaster]

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.

 

[CADFlyer]

SW Task Scheduler can export to the following formats:
.dxf
.dwg
.pdf
.step
.jpg

I know its not all 12, but its a start.

 

[ShaggyPE]

Have a look at Lenny's DocExport macro at the following link:

http://www.lennyworks.com/solidworks/default.asp?ID=20

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

 

[ShaggyPE]

Works great on 32-bit SW2010. Minor issues with selection window not popping up on 64 bit SW2012. Just use alt-tab to toggle to selection window. Do the same when macro is done to click "close".

-Dustin
Professional Engineer
Pretty good with SolidWorks

 

[CorBlimeyLimey]

Also works great on SW13 & Win7 x64

 

[hititfaster]

Thanks for the feedback guys - this could be REALLY useful!

 

[hititfaster]

I had a look into this - it's really good! I think there's potential for saving us a lot of time. Discovering the ability to save out individual config's was neat too. Thanks chaps!

 

[ShaggyPE]

I would wager that the docexport macro has saved me DAYS over the past 7 years.

-Dustin
Professional Engineer
Pretty good with SolidWorks

 

[hititfaster]

I can believe it - I passed it on to a colleague as well and within a few minutes he was cooing and making all sorts of impressed noises!

 

[tummen]

We started out by taking code from the internet and today we use this code that I made better and better.
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.

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