' Durchsucht die Properties nach den Eintraegen Fläche, Volumen und Masse
' und trägt diese als Benutzerdefinierte Properties ein
'
'---------------------------------------------------------------------------------




Sub FlaecheHolen()
'Schreibt die Flaeche des Bauteils in die benutzerdefinierten Eigenschaften als Eigenschaft "Flaeche"

'Nur im Part:
If ThisApplication.ActiveDocumentType = kPartDocumentObject Then
  
    Dim oDoc As PartDocument
    Set oDoc = ThisApplication.ActiveDocument
  
    Dim oUOM As UnitsOfMeasure
    Set oUOM = ThisApplication.ActiveDocument.UnitsOfMeasure
  
  ' Get the enum value that defines the current default length units.
    Dim eLengthUnit As UnitsTypeEnum
    eLengthUnit = oUOM.LengthUnits

    ' Get the equivalent string of the enum value.
    Dim sLengthUnit As String
    sLengthUnit = oUOM.GetStringFromType(eLengthUnit)

    ' Create a string that defines an area using the current length unit.
    Dim sAreaUnit As String
    sAreaUnit = sLengthUnit & "^2"

    ' Create a string showing the area in the current units.

    'Wie ist die Flaeche?
    Dim sArea As String
    sArea = "0 " & sAreaUnit
    sArea = oDoc.UnitsOfMeasure.GetStringFromValue(oDoc.ComponentDefinition.MassProperties.Area, sAreaUnit)
    'MsgBox "Parts area: " & sArea
    
    Dim sWert As String
    
    Dim sEinheit As String
    Dim rWert As Double
    
    sWert = Left$(sArea, InStr(1, sArea, " ", vbTextCompare))
    rWert = CDbl(sWert)
    sWert = Format$(rWert, "##0.0E+0")
    
    sEinheit = Mid$(sArea, InStr(1, sArea, " ", vbTextCompare) + 1)
    If sEinheit = "mm mm" Then
        sEinheit = " mm^2"
    End If
  
    sArea = sWert & sEinheit
    'Komma durch Punkt ersetzen
    'sArea = Replace(sArea, ",", ".", vbTextCompare)

    
    'Benutzerdefinierten Eintrag erzeugen
    'Masse vorhanden?
    Dim bFlaecheDa As Boolean
    Dim oProp As Property
    bFlaecheDa = False
    For Each oProp In oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}") 'Benutzerdefiniert
        If oProp.Name = "Flaeche" Then
            bFlaecheDa = True
            Exit For
        End If
    Next
    'Flaeche eintragen oder ändern
    If bFlaecheDa Then
        oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Item("Flaeche").Value = sArea
    Else
        oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Add sArea, "Flaeche"
    End If

End If


End Sub

Sub VolumenHolen()
'Schreibt das Volumen des Bauteils in die benutzerdefinierten Eigenschaften als Eigenschaft "Volumen"

'Nur im Part:
If ThisApplication.ActiveDocumentType = kPartDocumentObject Then
  
    Dim oDoc As PartDocument
    Set oDoc = ThisApplication.ActiveDocument
  
    Dim oUOM As UnitsOfMeasure
    Set oUOM = ThisApplication.ActiveDocument.UnitsOfMeasure
  
  ' Get the enum value that defines the current default length units.
    Dim eLengthUnit As UnitsTypeEnum
    eLengthUnit = oUOM.LengthUnits

    ' Get the equivalent string of the enum value.
    Dim sLengthUnit As String
    sLengthUnit = oUOM.GetStringFromType(eLengthUnit)

    ' Create a string that defines a volume using the current length unit.
    Dim sVolumeUnit As String
    sVolumeUnit = sLengthUnit & "^3"

    ' Create a string showing the volume in the current units.

    'Wie ist das Volumen?
    Dim sVolumen As String
    sVolumen = "0 " & sVolumeUnit
    sVolumen = oDoc.UnitsOfMeasure.GetStringFromValue(oDoc.ComponentDefinition.MassProperties.Volume, sVolumeUnit)
    'MsgBox "Parts volume: " & sVolumen
    
    Dim sWert As String
    Dim sEinheit As String
    Dim rWert As Double

    
    sWert = Left$(sVolumen, InStr(1, sVolumen, " ", vbTextCompare))
    
    rWert = CDbl(sWert)
    sWert = Format$(rWert, "##0.0E+0")
    
    sEinheit = Mid$(sVolumen, InStr(1, sVolumen, " ", vbTextCompare) + 1)
    
    If sEinheit = "mm mm mm" Then
        sEinheit = " mm^3"
    End If
  
    sVolumen = sWert & sEinheit
    'Komma durch Punkt ersetzen
    'sVolumen = Replace(sVolumen, ",", ".", vbTextCompare)

    
    'Benutzerdefinierten Eintrag erzeugen
    'Masse vorhanden?
    Dim bVolumenDa As Boolean
    Dim oProp As Property
    bVolumenDa = False
    For Each oProp In oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}") 'Benutzerdefiniert
        If oProp.Name = "Volumen" Then
        bVolumenDa = True
        Exit For
        End If
    Next
    'Volumen eintragen oder ändern
    If bVolumenDa Then
        oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Item("Volumen").Value = sVolumen
    Else
        oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Add sVolumen, "Volumen"
    End If

End If

End Sub



Sub GewichtHolen()
'Schreibt die Masse des Bauteils in die benutzerdefinierten Eigenschaften als Eigenschaft "Masse"

'Nur im Part:
If ThisApplication.ActiveDocumentType = kPartDocumentObject Then
  
  Dim oDoc As PartDocument
  Set oDoc = ThisApplication.ActiveDocument
  
  'Wie ist die Masse?
  Dim sMasse As String
  sMasse = oDoc.UnitsOfMeasure.GetStringFromValue(oDoc.ComponentDefinition.MassProperties.Mass, oDoc.UnitsOfMeasure.MassUnits)
  'Komma durch Punkt ersetzen
  'sMasse = Replace(sMasse, ",", ".", vbTextCompare)
  
  'Benutzerdefinierten Eintrag erzeugen
  'Masse vorhanden?
  Dim bMasseDa As Boolean
  Dim oProp As Property
  bMasseDa = False
  For Each oProp In oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}") 'Benutzerdefiniert
    If oProp.Name = "Masse" Then
      bMasseDa = True
      Exit For
    End If
  Next
  'Masse eintragen oder ändern
  If bMasseDa Then
    oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Item("Masse").Value = sMasse
  Else
    oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Add sMasse, "Masse"
  End If

End If

End Sub


Sub GewichtHolenAssembly()
'Schreibt die Masse des Bauteils in die benutzerdefinierten Eigenschaften als Eigenschaft "Masse"

'Nur im Part:
If ThisApplication.ActiveDocumentType = kAssemblyDocumentObject Then
  
  Dim oDoc As AssemblyDocument
  Set oDoc = ThisApplication.ActiveDocument
  
  'Wie ist die Masse?
  Dim sMasse As String
  sMasse = oDoc.UnitsOfMeasure.GetStringFromValue(oDoc.ComponentDefinition.MassProperties.Mass, oDoc.UnitsOfMeasure.MassUnits)
  'Komma durch Punkt ersetzen
  'sMasse = Replace(sMasse, ",", ".", vbTextCompare)
  
  'Benutzerdefinierten Eintrag erzeugen
  'Masse vorhanden?
  Dim bMasseDa As Boolean
  Dim oProp As Property
  bMasseDa = False
  For Each oProp In oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}") 'Benutzerdefiniert
    If oProp.Name = "Masse" Then
      bMasseDa = True
      Exit For
    End If
  Next
  'Masse eintragen oder ändern
  If bMasseDa Then
    oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Item("Masse").Value = sMasse
  Else
    oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Add sMasse, "Masse"
  End If

End If

End Sub