Folge 12 – Benutzereingaben mit der InputBox

Option Explicit
Option Compare Text
Sub main()
    Dim swApp As SldWorks.SldWorks
    Set swApp = Application.SldWorks
    
    Dim swModel As ModelDoc2
    Set swModel = swApp.ActiveDoc
    
    If swModel Is Nothing Then
        swApp.SendMsgToUser "Keine Dokument geladen."
        Exit Sub
    End If
    
    Dim FullName As String
    FullName = swModel.GetPathName
    
    If FullName = "" Then
        swApp.SendMsgToUser "Die Datei wurde noch nie gespeichert." & vbCrLf & "Makrolauf wird abgebrochen."
        Exit Sub
    End If
    Dim eingabe As String
    Do
    eingabe = InputBox("Dateiendung eingeben", "Speichern als")
    Debug.Print eingabe
    If eingabe = "" Then Exit Sub
    FullName = Left(FullName, Len(FullName) - 6) & eingabe
    Dim ReturnValue As Boolean
    Select Case eingabe
        Case "png", "jpg", "tif", "psd"
            Dim Errors As Long
            Dim Warnings As Long
            ReturnValue = swModel.Extension.SaveAs3(FullName, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, Nothing, Errors, Warnings)
        Case "pdf"
            Dim swExportPdfData As ExportPdfData
            Set swExportPdfData = swApp.GetExportFileData(swExportDataFileType_e.swExportPdfData)
            swExportPdfData.ViewPdfAfterSaving = False
            If swModel.GetType = swDocPART Or swModel.GetType = swDocASSEMBLY Then
                ReturnValue = swModel.Extension.SaveAs3(FullName, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, swExportPdfData, Nothing, Errors, Warnings)
            ElseIf swModel.GetType = swDocumentTypes_e.swDocDRAWING Then
                ReturnValue = swExportPdfData.SetSheets(swExportDataSheetsToExport_e.swExportData_ExportCurrentSheet, "")
            End If
        Case "dxf", "dwg"
            Dim swPart As PartDoc
            If swModel.GetType = swDocumentTypes_e.swDocPART Then
                Set swPart = swModel
                Dim varAlignment As Variant
                Dim dataAlignment(11) As Double
                dataAlignment(0) = 0#
                dataAlignment(1) = 0#
                dataAlignment(2) = 0#
                dataAlignment(3) = 1#
                dataAlignment(4) = 0#
                dataAlignment(5) = 0#
                dataAlignment(6) = 0#
                dataAlignment(7) = 1#
                dataAlignment(8) = 0#
                dataAlignment(9) = 0#
                dataAlignment(10) = 0#
                dataAlignment(11) = 1#
                varAlignment = dataAlignment
                ReturnValue = swPart.ExportToDWG2(FullName, swModel.GetPathName, swExportToDWG_e.swExportToDWG_ExportSheetMetal, True, varAlignment, False, False, 2053, Null)
            ElseIf swModel.GetType = swDocumentTypes_e.swDocDRAWING Then
                Dim tempSystemoptionAusgabeAktivieren As Integer
                tempSystemoptionAusgabeAktivieren = swApp.GetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfOutputNoScale)
                swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfOutputNoScale, 1
                ReturnValue = swModel.Extension.SaveAs3(FullName, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, Nothing, Errors, Warnings)
                swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfOutputNoScale, tempSystemoptionAusgabeAktivieren
            Else
                swApp.SendMsgToUser "Dieses Dokument wird nicht unterstützt."
                Exit Sub
            End If
        Case "stp", "step"
            If swModel.GetType = swDocPART Or swModel.GetType = swDocASSEMBLY Then
                Dim tempUserPref As Integer
                tempUserPref = swApp.GetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swStepAP)
                swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swStepAP, 214 '203/214
                ReturnValue = swModel.Extension.SaveAs3(FullName, swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, Nothing, Errors, Warnings)
                swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swStepAP, tempUserPref
            Else
                swApp.SendMsgToUser "Das STEP Format kann nur Teile oder Baugruppen speichern."
                Exit Sub
            End If
        Case Else
            swApp.SendMsgToUser "Dateiendung nicht unterstützt."
            Exit Sub
    End Select
    Debug.Print "Speichern erfolgreich? " & ReturnValue
    Loop
End Sub