Folge 30 – ListBox Inhalt ändern und zurück schreiben

In diesem Video werde ich zeigen, wie man die Werte aus der ListBox verändern kann und dann wieder in das Modell zurück schreibt.

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

{MainForm}

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
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()
    lb_dimensions.Clear
    Dim entry As Variant
    For Each entry In mod_swx.auslesen
        lb_dimensions.AddItem
        lb_dimensions.List(lb_dimensions.ListCount - 1, 0) = entry(0)
        lb_dimensions.List(lb_dimensions.ListCount - 1, 1) = entry(1)
        lb_dimensions.List(lb_dimensions.ListCount - 1, 2) = entry(2)
        lb_dimensions.List(lb_dimensions.ListCount - 1, 3) = entry(3)
    Next
End Sub
Private Sub buttonSchreiben_Click()
    Dim index As Integer
    For index = 0 To lb_dimensions.ListCount - 1
        eingabe_auswerten lb_dimensions.Column(3, index), _
                          lb_dimensions.Column(0, index) & "@" & _
                          lb_dimensions.Column(1, index) & "@" & _
                          lb_dimensions.Column(2, index)
    Next index
End Sub
Private Sub lb_dimensions_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    If lb_dimensions.ListIndex > -1 Then
        lbl_fullname.Caption = lb_dimensions.Column(0, lb_dimensions.ListIndex) & "@" & _
                               lb_dimensions.Column(1, lb_dimensions.ListIndex) & "@" & _
                               lb_dimensions.Column(2, lb_dimensions.ListIndex)
        tb_value.Text = lb_dimensions.Column(3, lb_dimensions.ListIndex)
    End If
End Sub
Private Sub tb_value_Change()
    If lb_dimensions.ListIndex > -1 Then lb_dimensions.List(lb_dimensions.ListIndex, 3) = tb_value.Text
End Sub
Private Sub UserForm_Initialize()
    mod_swx.check
End Sub

{mod_swx}

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
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() As Variant
    Dim swFeatureManager As FeatureManager
    Dim featureArray As Variant
    Dim listCounter As Long
    Dim vFeature As Variant
    Dim swFeature As Feature
    Dim swDisplayDimension As DisplayDimension
    Dim swDimension As Dimension
    Dim values As Variant
    Dim splitFullname As Variant
    Dim returnArray() As Variant
     
    Set swFeatureManager = swModel.FeatureManager
    featureArray = swFeatureManager.GetFeatures(True)
    listCounter = 0
    For Each vFeature In featureArray
        Set swFeature = vFeature
        If swFeature.GetTypeName2 = "Extrusion" Or swFeature.GetTypeName2 = "ICE" Then
            Set swDisplayDimension = swFeature.GetFirstDisplayDimension
            Do While Not swDisplayDimension Is Nothing
                Set swDimension = swDisplayDimension.GetDimension2(0)
                values = swDimension.GetValue3(swInConfigurationOpts_e.swThisConfiguration, "")
                splitFullname = Split(swDimension.fullname, "@")
                ReDim Preserve returnArray(0 To listCounter) As Variant
                returnArray(listCounter) = Array(splitFullname(0), splitFullname(1), splitFullname(2), values(0))
                listCounter = listCounter + 1
                Set swDisplayDimension = swFeature.GetNextDisplayDimension(swDisplayDimension)
            Loop
        End If
    Next
    auslesen = returnArray
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

Kommentare 4

  • Hello mr bernd.
    Thank you for your best clips.
    would you please help me? i have a question and i cant find the answer in the internet.
    How to write a code so that other people can use it but cannot see the contents of the code?

    Antworten

    • Hello,
      if you right click your project and click on properties, a window opens with two tabs. The second tab is for protecting your project. Please note that this kind of protection is not unhackable.

      Antworten

      • What is your suggestion for unhackable method? is there any way?

        Antworten

        • As far as I know there is no unhackable method for VBA macros. If you do not want anyone to see the code use an addin or stand-alone. There you have more options to make it harder for hackers. But this is not my topic. I do not know much of that.

          Antworten

Schreibe einen Kommentar zu FArshad Antworten abbrechen

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

➤