AnsweredAssumed Answered

Macro to automatically convert all part files into IGES

Question asked by Andy Krol on Mar 19, 2019
Latest reply on Apr 23, 2019 by Abhishek Lad

Can anyone help me with this:

I have this Macro created by Deepak Gupta (thanks so much for this), that converts all the drawings in the specified folder and converts them to PDF and saves them all in a PDF sub folder. This macro is a lifesaver for me as I do it all the time and it's much faster than Task Scheduler.

I'm trying to modify this Macro to to perform same tasks, but instead of converting drawings (.SLDDRW) to PDF, I want the macro to convert all the part files (.SLDPRT) to IGES and Save them in IGS sub folder.

 

here is the original Macro file that converts drawings to PDF, can anyone help with modifying it?

Thanks in Advance

 

' ------------------------------------------------------------------------------

' Written by: Deepak Gupta (http://gupta9665.com/)

' -------------------------------------------------------------------------------

 

Option Explicit

 

Private Const BIF_RETURNONLYFSDIRS As Long = &H1

Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2

Private Const BIF_RETURNFSANCESTORS As Long = &H8

Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000

Private Const BIF_BROWSEFORPRINTER As Long = &H2000

Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000

Private Const MAX_PATH As Long = 260

 

Function BrowseFolder(Optional Caption As String, Optional InitialFolder As String) As String

 

Dim SH As Shell32.Shell

Dim F As Shell32.Folder

 

Set SH = New Shell32.Shell

Set F = SH.BrowseforFolder(0&, Caption, BIF_RETURNONLYFSDIRS, InitialFolder)

If Not F Is Nothing Then

    If F = "Desktop" Then

        BrowseFolder = Environ("USERPROFILE") & "\Desktop"

    Else

        BrowseFolder = F.Items.Item.Path

    End If

End If

 

End Function

 

Sub Main()

Dim swApp        As SldWorks.SldWorks

Dim swModel      As SldWorks.ModelDoc

Dim sFileName    As String

Dim Path         As String

Dim PDFpath      As String

Dim nErrors      As Long

Dim nWarnings    As Long

Dim swDraw       As SldWorks.DrawingDoc

Dim PartNoDes    As String

Dim swExportPDFData As SldWorks.ExportPdfData

 

 

    Set swApp = Application.SldWorks

    Set swExportPDFData = swApp.GetExportFileData(1)

    swExportPDFData.ViewPdfAfterSaving = False

     

    Path = BrowseFolder("Select a Path/Folder")

    If Path = "" Then

        MsgBox "Please select the path and try again"

        End

    Else

    Path = Path + "\"

    End If

     

    PDFpath = Path & "PDF"

    If Dir(PDFpath, vbDirectory) = "" Then MkDir PDFpath

          

    sFileName = Dir(Path & "*.slddrw")

    Do Until sFileName = ""

        Set swModel = swApp.OpenDoc6(Path + sFileName, swDocDRAWING, swOpenDocOptions_Silent, "", nErrors, nWarnings)

        Set swModel = swApp.ActiveDoc

        Set swDraw = swApp.ActiveDoc

            PartNoDes = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)

            PartNoDes = Left(PartNoDes, Len(PartNoDes) - 7)

            swDraw.SaveAs3 PDFpath & "\" & PartNoDes & ".PDF", 0, 0

        swApp.QuitDoc swDraw.GetPathName

        Set swDraw = Nothing

        Set swModel = Nothing

        sFileName = Dir

    Loop

 

MsgBox "All Done"

End Sub

Outcomes