Folge 12 – Benutzereingaben mit der InputBox

In diesem Video zeige ich wie eine Benutzereingabe im Makrolauf mit der InputBox erfolgen kann.

Und an dieser Stelle der Code der im Makro vorhanden ist.

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
Code-Sprache: VB.NET (vbnet)

Schreibe einen Kommentar

Deine E-Mail-Adresse wird nicht veröffentlicht. Erforderliche Felder sind mit * markiert