Folge 26 – Bemaßungen schreiben

Option Explicit
Private Sub eingabe_auswerten(ByVal wert As String, ByVal adresse As String)
    If IsNumeric(wert) Then
        If CDbl(wert) > 0 Then
            mod_swx.schreiben adresse, CDbl(wert)
        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, "Höhe@Grundkörper Skizze"
    eingabe_auswerten textboxLaenge.Text, "Länge@Grundkörper Skizze"
    eingabe_auswerten textboxBreite.Text, "Breite@Grundkörper"
End Sub
Private Sub UserForm_Initialize()
    mod_swx.check
End Sub

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
Sub schreiben(fullname As String, newValue As Double)
    Dim swDimension As Dimension
    Set swDimension = swModel.Parameter(fullname)
    If Not swDimension Is Nothing Then
        Dim returnValue As swSetValueReturnStatus_e
        returnValue = swDimension.SetValue3(newValue, swSetValueInConfiguration_e.swSetValue_InThisConfiguration, Nothing)
        Select Case returnValue
            Case swSetValue_Failure
                swApp.SendMsgToUser "Wert konnte aus unbekanntem Grund nicht gesetzt werden."
            Case swSetValue_InvalidValue
                swApp.SendMsgToUser "Der Wert war nicht geeignet um diesen Parameter zu ändern."
            Case swSetValue_DrivenDimension
                swApp.SendMsgToUser "Kann nicht auf eine Bemassung angewendet werden, welche durch die Geometrie bestimmt ist."
            Case swSetValue_ModelNotLoaded
                swApp.SendMsgToUser "Modell muss geladen sein um den Wert zu setzen."
            Case swSetValue_FrozenFeatureOwner
                swApp.SendMsgToUser "Besitzer der Bemassung ist eingefroren."
        End Select
        Dim bool As Boolean
        bool = swModel.ForceRebuild3(False)
    Else
        swApp.SendMsgToUser "Die Bemassung mit dem Namen(" & fullname & ") gibt es nicht in dem aktuellen Modell."
    End If
End Sub