Hi Everyone,

Wanted to see if anyone out there could help me out, I'm trying to set up a Marco for converting an Assembly into a 3D PDF, I've taken code from here   but have had no luck with getting it to work. I have a PDF macro for drawings (code below) that was created before my time that I was basing the 3D PDF but my knowledge of coding is limited and wanted to know if anyone has come across any examples of how to set this up.

Thanks in advance,

Samuel

Option Explicit

    Dim swApp                   As SldWorks.SldWorks

    Dim swModel                 As SldWorks.ModelDoc2

    Dim sPathName               As String

    Dim sRev                    As String

    Dim nRetval                 As Long

    Dim bShowMap                As Boolean

    Dim swModelDocExt           As SldWorks.ModelDocExtension

    Dim swExportData            As SldWorks.ExportPdfData

    Dim boolstatus              As Boolean

    Dim swCustProp              As CustomPropertyManager

    Dim valOut                  As String

    Dim resolvedValOut          As String

    Dim swView                  As SldWorks.View

    Const sPath                 As String = "\\\\server-02\\company documents\\Claydon Yieldometer.Ltd\\Manufacture\\Design Technical Drawings\\All Drawings" ' Change path here

Sub main()

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    sPathName = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\\") + 1)

    sPathName = Left(sPathName, InStrRev(sPathName, ".") - 1)

If (swModel.GetType = SwConst.swDocumentTypes_e.swDocDRAWING) Then

        Set swView = swModel.GetFirstView

        Set swView = swView.GetNextView

        Set swCustProp = swView.ReferencedDocument.Extension.CustomPropertyManager("")

        swCustProp.Get2 "Revision", valOut, resolvedValOut

        Set swExportData = swApp.GetExportFileData(swExportPDFData)

        boolstatus = swExportData.SetSheets(swExportData_ExportAllSheets, 1)

        boolstatus = swModel.SaveAs4(sPath + "\\" + sPathName + "-" + resolvedValOut + ".PDF", swSaveAsCurrentVersion, swSaveAsOptions_Silent, 0, 0)

        swApp.SetUserPreferenceToggle swDXFDontShowMap, False

        If boolstatus Then

            MsgBox "EXPORT OF " & sPathName + " SUCCESSFUL" & vbNewLine + "PDF SAVED TO ALL DRAWINGS"

        Else

            MsgBox "Save as PDF failed." & vbNewLine + "Ensure PDF isn't already open"

        End If

    End If

End Sub