Folge 17 – Formular erweitern: PDF

Option Explicit
Private Sub btnABBRECHEN_Click()
    End
End Sub
Private Sub btnSPEICHERN_Click()
    If ckbPDF.Value = True Then
        mod_pdf.speichern
    End If
    If ckbDXF.Value = True Then
        mod_dxf.speichern
    End If
    If ckbSTEP.Value = True Then
        mod_step.speichern
    End If
    End
End Sub
Private Sub UserForm_Initialize()
    mod_swx.modell_pruefen
    If mod_swx.IsModelPartDoc Then
        optn_pdf_aio.Enabled = False
        optn_pdf_single.Enabled = False
        lb_sheets.Enabled = False
        lb_sheets.BackColor = RGB(225, 225, 225)
        frm_pdf_sheets.Enabled = False
        frm_pdf_save_in.Enabled = False
        mod_swx.hole_modelansichten
    ElseIf mod_swx.IsModelAssemblyDoc Then
        optn_pdf_aio.Enabled = False
        optn_pdf_single.Enabled = False
        lb_sheets.Enabled = False
        lb_sheets.BackColor = RGB(225, 225, 225)
        frm_pdf_sheets.Enabled = False
        frm_pdf_save_in.Enabled = False
        mod_swx.hole_modelansichten
    ElseIf mod_swx.IsModelDrawingDoc Then
        ckbSTEP.Enabled = False
        optn_step203.Enabled = False
        optn_step214.Enabled = False
        lb_views.Enabled = False
        lb_views.BackColor = RGB(225, 225, 225)
        frm_pdf_views.Enabled = False
        mod_swx.hole_blattnamen
    Else
        ckbSTEP.Enabled = False
        optn_step203.Enabled = False
        optn_step214.Enabled = False
        ckbPDF.Enabled = False
        ckbDXF.Enabled = False
        optn_pdf_aio.Enabled = False
        optn_pdf_single.Enabled = False
        lb_sheets.Enabled = False
        lb_views.Enabled = False
        frm_pdf_save_in.Enabled = False
        frm_pdf_sheets.Enabled = False
        frm_pdf_views.Enabled = False
        lb_sheets.BackColor = RGB(225, 225, 225)
        lb_views.BackColor = RGB(225, 225, 225)
    End If
    tbxDATEINAME.Text = mod_swx.dateiname_auslesen
End Sub

Option Explicit
Public swApp As SldWorks.SldWorks
Public swModel As ModelDoc2
Public swDrawingDoc As DrawingDoc
Sub modell_pruefen()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then
        swApp.SendMsgToUser "Keine Dokument geladen."
        End
    End If
    If GetFullName = "" Then
        swApp.SendMsgToUser "Die Datei wurde noch nie gespeichert." & vbCrLf & "Makrolauf wird abgebrochen."
        End
    End If
End Sub
Function dateiname_auslesen()
    Dim Dateiname As String
    Dim temp As Variant
    temp = Split(GetFullName, "\")
    Dateiname = temp(UBound(temp))
    dateiname_auslesen = Left(Dateiname, Len(Dateiname) - 7)
End Function
Private Function GetFullName()
    GetFullName = swModel.GetPathName
End Function
Function IsModelPartDoc()
    If swModel.GetType = swDocumentTypes_e.swDocPART Then
        IsModelPartDoc = True
    Else
        IsModelPartDoc = False
    End If
End Function
Function IsModelAssemblyDoc()
    If swModel.GetType = swDocumentTypes_e.swDocASSEMBLY Then
        IsModelAssemblyDoc = True
    Else
        IsModelAssemblyDoc = False
    End If
End Function
Function IsModelDrawingDoc()
    If swModel.GetType = swDocumentTypes_e.swDocDRAWING Then
        IsModelDrawingDoc = True
        Set swDrawingDoc = swModel
    Else
        IsModelDrawingDoc = False
    End If
End Function
Sub hole_blattnamen()
    Dim vSheetNames As Variant
    vSheetNames = swDrawingDoc.GetSheetNames
    Dim counter As Integer
    For counter = 0 To UBound(vSheetNames)
        MainForm.lb_sheets.AddItem (vSheetNames(counter))
    Next counter
End Sub
Sub hole_modelansichten()
    Dim vModelViewNames As Variant
    vModelViewNames = swModel.GetModelViewNames
    Dim counter As Integer
    For counter = 0 To UBound(vModelViewNames)
        MainForm.lb_views.AddItem (vModelViewNames(counter))
    Next counter
End Sub
Function NameUndPfadZumSpeichern(endung As String)
    Dim NameUndPfad As String
    NameUndPfad = swModel.GetPathName
    Dim NurPfad As String
    Dim temp As Variant
    temp = Split(NameUndPfad, "\")
    Dim i As Integer
    For i = LBound(temp) To UBound(temp) - 1
        NurPfad = NurPfad & temp(i) & "\"
    Next i
    NameUndPfadZumSpeichern = NurPfad & MainForm.tbxDATEINAME.Text & "." & endung
End Function

Option Explicit
Sub speichern()
    Dim tempUserPref As Integer
    tempUserPref = swApp.GetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swStepAP)
    Dim stepVersion As Integer
    If MainForm.optn_step214.Value = True Then
        stepVersion = 214
    Else
        stepVersion = 203
    End If
    swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swStepAP, stepVersion
    Dim Errors As Long
    Dim Warnings As Long
    Dim ReturnValue As Boolean
    ReturnValue = swModel.Extension.SaveAs3(NameUndPfadZumSpeichern("stp"), swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, Nothing, Errors, Warnings)
    Debug.Print "Errors: " & Errors
    Debug.Print "Warnings: " & Warnings
    Debug.Print "Return Value: " & ReturnValue
    swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swStepAP, tempUserPref
End Sub

Option Explicit
Sub speichern()
    Dim Errors As Long
    Dim Warnings As Long
    Dim ReturnValue As Boolean
    Dim swExportPdfData As ExportPdfData
    Set swExportPdfData = swApp.GetExportFileData(swExportDataFileType_e.swExportPdfData)
    swExportPdfData.ViewPdfAfterSaving = False
    Dim listCounter As Integer
    Dim selectionCounter As Integer
    Dim index As Integer
    If mod_swx.IsModelDrawingDoc Then
        Dim sheetNames() As String
        listCounter = MainForm.lb_sheets.ListCount
        For index = 0 To listCounter - 1
            If MainForm.lb_sheets.Selected(index) Then
                ReDim Preserve sheetNames(selectionCounter)
                sheetNames(selectionCounter) = MainForm.lb_sheets.Column(0, index)
                selectionCounter = selectionCounter + 1
            End If
        Next index
        If selectionCounter = 0 Then Exit Sub
        If MainForm.optn_pdf_aio.Value = True Then
            Dim varSheetNames As Variant
            varSheetNames = sheetNames
            ReturnValue = swExportPdfData.SetSheets(swExportDataSheetsToExport_e.swExportData_ExportSpecifiedSheets, varSheetNames)
            ReturnValue = swModel.Extension.SaveAs3(NameUndPfadZumSpeichern("pdf"), swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, swExportPdfData, Nothing, Errors, Warnings)
        ElseIf MainForm.optn_pdf_single.Value = True Then
            Dim varSheetName As Variant
            For Each varSheetName In sheetNames
                ReturnValue = swExportPdfData.SetSheets(swExportDataSheetsToExport_e.swExportData_ExportSpecifiedSheets, varSheetName)
                ReturnValue = swModel.Extension.SaveAs3(NameUndPfadZumSpeichern(varSheetName & ".pdf"), swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, swExportPdfData, Nothing, Errors, Warnings)
            Next
        End If
    ElseIf mod_swx.IsModelAssemblyDoc Or mod_swx.IsModelPartDoc Then
        Dim viewNames() As Variant
        listCounter = MainForm.lb_views.ListCount
        For index = 0 To listCounter - 1
            If MainForm.lb_views.Selected(index) Then
                ReDim Preserve viewNames(selectionCounter)
                viewNames(selectionCounter) = MainForm.lb_views.Column(0, index)
                selectionCounter = selectionCounter + 1
            End If
        Next index
        If selectionCounter = 0 Then Exit Sub
        Dim varViewName As Variant
        Dim newName As String
        For Each varViewName In viewNames
            swModel.ShowNamedView2 varViewName, -1
            swModel.ViewZoomtofit2
            If Left(varViewName, 1) = "*" Then
                newName = Mid(varViewName, 2)
            Else
                newName = varViewName
            End If
            ReturnValue = swModel.Extension.SaveAs3(NameUndPfadZumSpeichern(newName & ".pdf"), swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, swExportPdfData, Nothing, Errors, Warnings)
        Next
    End If
End Sub

Option Explicit
Sub speichern()
    Debug.Print "DXF speichern"
End Sub