Folge 10 – Speichern ins DXF/DWG Format

Option Explicit
 
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 "Kein Dokument geladen."
        Exit Sub
    End If
     
    Dim Errors As Long
    Dim Warnings As Long
    Dim FullName As String
    Dim ReturnValue As Boolean
    FullName = swModel.GetPathName
    FullName = Left(FullName, Len(FullName) - 6) & "dxf"
    Dim swPartDoc as PartDoc
    If swModel.GetType = swDocumentTypes_e.swDocPart Then
        Set swPartDoc = 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 = swPartDoc.ExportToDWG2(FullName, swModel.GetPathName, swExportToDWG_e.swExportToDWG_ExportSheetMetal, True, varAlignment, False, False, 2053, Null)
        Debug.Print "Speichern erfolgreich? " & ReturnValue
    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
        Debug.Print "Errors: " & Errors
        Debug.Print "Warnings: " & Warnings
        Debug.Print "Return Value: " & ReturnValue
    Else
        swApp.SendMsgToUser "Dieses Dokument wird nicht unterstützt."
        Exit Sub
    End If
End Sub