Folge 25 – Bemaßungen auslesen

In diesem Video werde ich die Werte aus den Bemaßungen auslesen und in die Textfelder schreiben.

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

{MainForm}

Option Explicit
Private Sub eingabe_auswerten(ByVal wert As String)
    If IsNumeric(wert) Then
        If CDbl(wert) > 0 Then
        
        Else
            MsgBox ("Die Zahl darf nicht kleiner oder gleich 0 sein.")
        End If
    Else
        MsgBox ("Der Inhalt konnte nicht in eine Zahl umgewandelt werden." & vbCrLf & "Der Inhalt ist: " & wert)
    End If
End Sub
Private Sub buttonAuslesen_Click()
    textboxHoehe.Text = mod_swx.auslesen("Höhe@Grundkörper Skizze")
    textboxLaenge.Text = mod_swx.auslesen("Länge@Grundkörper Skizze")
    textboxBreite.Text = mod_swx.auslesen("Breite@Grundkörper")
End Sub
Private Sub buttonSchreiben_Click()
    eingabe_auswerten textboxHoehe.Text
    eingabe_auswerten textboxLaenge.Text
    eingabe_auswerten textboxBreite.Text
End Sub
Private Sub UserForm_Initialize()
    mod_swx.check
End Sub

{mod_swx}

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Sub check()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then
        swApp.SendMsgToUser2 "Keine Datei geöffnet.", swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
        End
    End If
End Sub
Function auslesen(fullname As String)
    Dim swDimension As Dimension
    Set swDimension = swModel.Parameter(fullname)
    Dim arrDimension As Variant
    If Not swDimension Is Nothing Then
        arrDimension = swDimension.GetValue3(swInConfigurationOpts_e.swThisConfiguration, Nothing)
        auslesen = arrDimension(0)
    Else
        swApp.SendMsgToUser "Die Bemassung mit dem Namen(" & fullname & ") gibt es nicht in dem aktuellen Modell."
    End If
End Function

Schreibe einen Kommentar

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