Mass Property

In diesem Stream zeige ich wie man das Gewicht eines Teil ermittelt und nach bestimmten Kriterien in die Dateieigenschaften schreibt.

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

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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
Option Explicit
 
Dim swApp As SldWorks.SldWorks
Dim swxModelDoc As ModelDoc2
Dim swxModelDocExtension As ModelDocExtension
Dim swxCustomPropertyManager As CustomPropertyManager
Dim fileType As Long
Dim fileName As String
 
Const cQTY = "QTY"
Const cWEIGHT = "Gewicht"
Const cMATERIAL = "Material"
Const cUNIT = "Einheit"
 
Sub main()
    Dim returnValue As Long
    Dim valOut As String
    Dim resolvedValOut As String
    Dim wasResolved As Boolean
    Dim linkToProp As Boolean
    Set swApp = Application.SldWorks
    Set swxModelDoc = swApp.ActiveDoc
    If swxModelDoc Is Nothing Then
        swApp.SendMsgToUser2 "Keine Datei geladen.", swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
        End
    End If
    fileName = swxModelDoc.GetPathName
    If fileName = "" Then
        swApp.SendMsgToUser2 "Die Datei muss Initial gespeichert werden.", swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
        End
    End If
    Set swxModelDocExtension = swxModelDoc.Extension
    fileType = swxModelDoc.GetType
    ' QTY richtig einstellen
    If fileType = swDocumentTypes_e.swDocASSEMBLY Or fileType = swDocumentTypes_e.swDocPART Then
        Set swxCustomPropertyManager = swxModelDocExtension.CustomPropertyManager("")
        returnValue = swxCustomPropertyManager.Add3(cQTY, swCustomInfoType_e.swCustomInfoNumber, _
                      1, swCustomPropertyAddOption_e.swCustomPropertyOnlyIfNew)
        swxCustomPropertyManager.Get6 cQTY, False, valOut, resolvedValOut, wasResolved, linkToProp
        If returnValue <> 0 Then
            If IsNumeric(resolvedValOut) Then
                If CDbl(resolvedValOut) <= 0 Then resolvedValOut = 1
            Else
                swApp.SendMsgToUser2 "In das Feld " & cQTY & "dürfen nur Zahlen eingegeben werden.", swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
                End
            End If
        End If
        WriteToProperty cQTY, resolvedValOut, "number"
    End If
    ' Gewicht richtig einstellen
    If fileType = swDocumentTypes_e.swDocASSEMBLY Or fileType = swDocumentTypes_e.swDocPART Then
        Dim weight As String
        Dim swxMassProperty As MassProperty2
        Set swxMassProperty = swxModelDocExtension.CreateMassProperty2
        If Not swxMassProperty Is Nothing Then
            If swxMassProperty.Mass < 1 Then
                If swxMassProperty.Mass < 0.001 Then
                    weight = CStr(Round(swxMassProperty.Mass, 5) * 1000) & "g"
                Else
                    weight = CStr(Round(swxMassProperty.Mass, 3) * 1000) & "g"
                End If
            ElseIf swxMassProperty.Mass > 10 Then
                weight = CStr(Round(swxMassProperty.Mass, 0)) & "kg"
            Else
                weight = CStr(Round(swxMassProperty.Mass, 2)) & "kg"
            End If
        Else
           weight = "0g"
        End If
        weight = Replace(weight, ",", ".")
        WriteToProperty cWEIGHT, weight, "text"
    End If
    ' Material eintragen
    If fileType = swDocumentTypes_e.swDocPART Then
        Dim tempSplit As Variant
        tempSplit = Split(fileName, "\")
        WriteToProperty cMATERIAL, Chr(34) & "SW-Material@" & tempSplit(UBound(tempSplit)) & Chr(34), "text"
    End If
    ' Einheit eingetragen
    If fileType = swDocumentTypes_e.swDocASSEMBLY Or fileType = swDocumentTypes_e.swDocPART Then
        Set swxCustomPropertyManager = swxModelDocExtension.CustomPropertyManager("")
        swxCustomPropertyManager.Get6 cUNIT, False, valOut, resolvedValOut, wasResolved, linkToProp
        If resolvedValOut = "" Then
            WriteToProperty cUNIT, "ST", "text"
        End If
    End If
End Sub
 
Sub WriteToProperty(ByVal constant As String, ByVal value As Variant, ByVal typ As String)
    Dim customInfoType As swCustomInfoType_e
    If typ = "text" Then customInfoType = swCustomInfoText Else customInfoType = swCustomInfoNumber
    Set swxCustomPropertyManager = swxModelDocExtension.CustomPropertyManager("")
    swxCustomPropertyManager.Add3 constant, customInfoType, value, _
                                  swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd
    Dim arrayOfConfigurationNames As Variant
    arrayOfConfigurationNames = swxModelDoc.GetConfigurationNames()
    Dim name As Variant
    For Each name In arrayOfConfigurationNames
        Set swxCustomPropertyManager = swxModelDocExtension.CustomPropertyManager(name)
        swxCustomPropertyManager.Add3 constant, customInfoType, value, _
                                      swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd
    Next
End Sub

Schreibe einen Kommentar

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

➤