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