Folge 18 – Formular erweitern: DXF

In diesem Video mache ich an der Stelle weiter, wo ich in Folge 17 aufgehört habe.
Ich werde das Formular um Funktionen erweitern, damit DXF Daten exportiert werden können.

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

{MainForm}

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 cbx_dxf_save_unfold_Change()
    If cbx_dxf_save_unfold.Value = True Then
        cbx_dxf_bendlines.Enabled = True
    Else
        cbx_dxf_bendlines.Enabled = False
    End If
End Sub
Private Sub UserForm_Initialize()
    mod_swx.modell_pruefen
    If mod_swx.IsModelPartDoc Then
        frm_pdf_save_in.Enabled = False
        optn_pdf_aio.Enabled = False
        optn_pdf_single.Enabled = False
        frm_pdf_sheets.Enabled = False
        lb_sheets.Enabled = False
        lb_sheets.BackColor = RGB(225, 225, 225)
        frm_dxf_options.Enabled = False
        cbx_dxf_scale.Enabled = False
        cbx_dxf_active_sheet_only.Enabled = False
        If Not mod_swx.IsPartSheetMetal Then
            frm_dxf_sheetpart.Enabled = False
            cbx_dxf_save_unfold.Enabled = False
        End If
        cbx_dxf_bendlines.Enabled = False
        mod_swx.hole_modelansichten lb_views
        mod_swx.hole_modelansichten lb_dxf_views
    ElseIf mod_swx.IsModelAssemblyDoc Then
        frm_pdf_save_in.Enabled = False
        optn_pdf_aio.Enabled = False
        optn_pdf_single.Enabled = False
        frm_pdf_sheets.Enabled = False
        lb_sheets.Enabled = False
        lb_sheets.BackColor = RGB(225, 225, 225)
        frm_dxf_sheetpart.Enabled = False
        cbx_dxf_save_unfold.Enabled = False
        cbx_dxf_bendlines.Enabled = False
        frm_dxf_options.Enabled = False
        cbx_dxf_scale.Enabled = False
        cbx_dxf_active_sheet_only.Enabled = False
        mod_swx.hole_modelansichten lb_views
        mod_swx.hole_modelansichten lb_dxf_views
    ElseIf mod_swx.IsModelDrawingDoc Then
        frm_pdf_views.Enabled = False
        lb_views.Enabled = False
        lb_views.BackColor = RGB(225, 225, 225)
        ckbSTEP.Enabled = False
        optn_step203.Enabled = False
        optn_step214.Enabled = False
        frm_dxf_sheetpart.Enabled = False
        cbx_dxf_save_unfold.Enabled = False
        cbx_dxf_bendlines.Enabled = False
        frm_dxf_views.Enabled = False
        lb_dxf_views.Enabled = False
        lb_dxf_views.BackColor = RGB(225, 225, 225)
        mod_swx.hole_blattnamen
    Else
        frm_pdf_save_in.Enabled = False
        optn_pdf_aio.Enabled = False
        optn_pdf_single.Enabled = False
        frm_pdf_sheets.Enabled = False
        lb_sheets.Enabled = False
        lb_sheets.BackColor = RGB(225, 225, 225)
        frm_pdf_views.Enabled = False
        lb_views.Enabled = False
        lb_views.BackColor = RGB(225, 225, 225)
        ckbSTEP.Enabled = False
        optn_step203.Enabled = False
        optn_step214.Enabled = False
        frm_dxf_sheetpart.Enabled = False
        cbx_dxf_save_unfold.Enabled = False
        cbx_dxf_bendlines.Enabled = False
        frm_dxf_options.Enabled = False
        cbx_dxf_scale.Enabled = False
        cbx_dxf_active_sheet_only.Enabled = False
        frm_dxf_views.Enabled = False
        lb_dxf_views.Enabled = False
        lb_dxf_views.BackColor = RGB(225, 225, 225)
    End If
    tbxDATEINAME.Text = mod_swx.dateiname_auslesen
End Sub

{mod_swx}

Option Explicit
Public swApp As SldWorks.SldWorks
Public swModel As ModelDoc2
Public swDrawingDoc As DrawingDoc
Public swPartDoc As PartDoc
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
        Set swPartDoc = swModel
    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(lb As ListBox)
    Dim vModelViewNames As Variant
    vModelViewNames = swModel.GetModelViewNames
    Dim counter As Integer
    For counter = 0 To UBound(vModelViewNames)
        lb.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
Function IsPartSheetMetal()
    Dim vBodies As Variant
    vBodies = swPartDoc.GetBodies2(swBodyType_e.swAllBodies, False)
    Dim swBody As Body2
    Dim counter As Integer
    For counter = 0 To UBound(vBodies)
        Set swBody = vBodies(counter)
        If swBody.IsSheetMetal Then
            IsPartSheetMetal = True
            Exit Function
        End If
    Next counter
    IsPartSheetMetal = False
End Function

{mod_step}

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

{mod_pdf}

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 index As Integer
    Dim selectionCounter As Integer
    If mod_swx.IsModelDrawingDoc Then
        listCounter = MainForm.lb_sheets.ListCount
        Dim sheetNames() As String
        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
        listCounter = MainForm.lb_views.ListCount
        Dim viewNames() As Variant
        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

{mod_dxf}

Option Explicit
Sub speichern()
    Dim Errors As Long
    Dim Warnings As Long
    If mod_swx.IsModelDrawingDoc Then
        Dim tempSwDxfOutputNoScale As Integer
        tempSwDxfOutputNoScale = swApp.GetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfOutputNoScale)
        Dim tempSwDxfMultiSheetOption As Integer
        tempSwDxfMultiSheetOption = swApp.GetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfMultiSheetOption)
        If MainForm.cbx_dxf_scale.Value = True Then
            swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfOutputNoScale, 1
        ElseIf MainForm.cbx_dxf_scale.Value = False Then
            swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfOutputNoScale, 0
        End If
        If MainForm.cbx_dxf_active_sheet_only.Value = True Then
            swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfMultisheet_e.swDxfActiveSheetOnly
        ElseIf MainForm.cbx_dxf_active_sheet_only.Value = False Then
            swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfMultisheet_e.swDxfSeparateSheets
        End If
        swModel.Extension.SaveAs3 mod_swx.NameUndPfadZumSpeichern("dxf"), swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, Nothing, Errors, Warnings
        swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfOutputNoScale, tempSwDxfOutputNoScale
        swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, tempSwDxfMultiSheetOption
    End If
    If mod_swx.IsModelPartDoc Then 'erweiterbar um "or mod_swx.IsModelAssemblyDoc" für Baugruppennutzung
        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
        If MainForm.cbx_dxf_save_unfold.Value = True Then
            Dim bitMask As Integer
            bitMask = 1
            If MainForm.cbx_dxf_bendlines.Value = True Then
                bitMask = bitMask + 4
            End If
            swPartDoc.ExportToDWG2 mod_swx.NameUndPfadZumSpeichern("Abwicklung.dxf"), swModel.GetPathName, swExportToDWG_e.swExportToDWG_ExportSheetMetal, True, varAlignment, False, False, bitMask, Null
        End If
        Dim viewNames() As String
        Dim listCounter As Integer
        listCounter = MainForm.lb_dxf_views.ListCount
        Dim selectionCounter As Integer
        Dim index As Integer
        For index = 0 To listCounter - 1
            If MainForm.lb_dxf_views.Selected(index) Then
                ReDim Preserve viewNames(selectionCounter)
                viewNames(selectionCounter) = MainForm.lb_dxf_views.Column(0, index)
                selectionCounter = selectionCounter + 1
            End If
        Next index
        Dim ReturnValue As Boolean
        If selectionCounter > 0 Then
            Dim sPathName As String
            Dim sModelName As String
            Dim varViews As Variant
            sPathName = mod_swx.NameUndPfadZumSpeichern("dxf")
            sModelName = swModel.GetPathName
            varViews = viewNames
            swPartDoc.ExportToDWG2 sPathName, sModelName, swExportToDWG_e.swExportToDWG_ExportAnnotationViews, False, varAlignment, False, False, 0, varViews
        End If
    End If
End Sub

Kommentare 2

  • Sehr geehrter Hr. Hornemann,
    mit großem Interesse habe ich ihre Tutorials verfolgt und möchte ihnen auf diesem Weg dazu gratulieren. Es ist ihnen hervorragend gelungen etwas Licht und Struktur in die Systematik „API“ zu bringen. Weiter so!

    Antworten

    • Vielen Dank für das Lob. Es freut mich sehr, wenn ich mit meinen Beiträgen helfen kann dieses Thema für alle verständlicher zu machen.

      Antworten

Schreibe einen Kommentar

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

➤