3 Replies Latest reply on Oct 5, 2017 5:00 PM by Amen Allah Jlili

    Macro Batch export multisheet solidworks to multiple dwg with modelname as dwg filename

    Nicolas Box-Rubio

      Hi guys,

       

      I need to improve a macro I'm actually using to export each sheets of a Solidworks drawing into separate dwg file using the model's filename shown on the sheet as the filename of the dwg.

       

      Example:

      Sheet1: model 46407-C    -> dwg file: 46407-C.dwg

      Sheet2: model 46407-C1  -> dwg file: 46407-C1.dwg

      Sheet3: model 46407-C2  -> dwg file: 46407-C2.dwg

      ....

       

      So far I'm using the following macro to save, export as a single pdf, exports to separate dwg and close the drawing but it exports the sheets to dwg files named 00_46407-C.dwg

       

      Sub main()

       

      Set swApp = Application.SldWorks

      Set Part = swApp.ActiveDoc

      On Error Resume Next

      Dim FilePath As String

      Dim PathSize As Long

      Dim PathNoExtension As String

      Dim NewFilePath As String

       

      FilePath = Part.GetPathName

      PathSize = Strings.Len(FilePath)

      PathNoExtension = Strings.Left(FilePath, PathSize - 6)

       

      NewFilePath = PathNoExtension & "slddrw"

       

      Part.SaveAs2 NewFilePath, 0, True, False

      'MsgBox "Saved " & NewFilePath

       

      NewFilePath = PathNoExtension & "pdf"

       

      Part.SaveAs2 NewFilePath, 0, True, False

      'MsgBox "Saved " & NewFilePath

       

      NewFilePath = PathNoExtension & "dwg"

       

      Part.SaveAs2 NewFilePath, 0, True, False

      'MsgBox "Saved " & NewFilePath

       

      swApp.ActiveDoc.ActiveView.FrameState = 1

      Set Part = Nothing

      swApp.CloseDoc FilePath

      swApp.ActiveDoc.ActiveView.FrameLeft = 0

      swApp.ActiveDoc.ActiveView.FrameTop = 0

      swApp.ActiveDoc.ActiveView.FrameState = 1

      \'Set Part = swApp.ActiveDoc

      'Set SelMgr = Part.SelectionManager

      'swApp.ActiveDoc.ActiveView.FrameState = 1

      'Part.Extension.SaveAs "M:\OEM projects\2008\Q059638 Boeing 10-60593-16 Return Filter Assembly\RECENT PDF'S\1761291-01.PDF", 0, 0, Nothing, longstatus, longwarnings

      End Sub

       

      Thanks for your help.

       

      Nicolas