Sub WriteIPropsToParams()
    
    If ThisApplication.ActiveDocumentType <> kAssemblyDocumentObject And _
        ThisApplication.ActiveDocumentType <> kPartDocumentObject Then
        'MsgBox "Only Part or Assymbly document", vbCritical
        Exit Sub
    End If
    
  ' Declare the Application object
    Dim oApplication As Inventor.Application

    ' Obtain the Inventor Application object.
    ' This assumes Inventor is already running.
    Set oApplication = ThisApplication
    
    ' Set a reference to the active document.
    ' This assumes a document is open.
    Dim oDoc As Document
    Set oDoc = oApplication.ActiveDocument
    
    Dim vPropValue As Variant
    Dim sPropName As String
    
    
   
    Dim oParams As Parameters
    Set oParams = ThisApplication.ActiveDocument.ComponentDefinition.Parameters
    
    Dim i As Long
    
    Dim bMasseFound As Boolean
    Dim bFlaecheFound As Boolean
    Dim bVolumenFound As Boolean
    
    bMasseFound = False
    bFlaecheFound = False
    bVolumenFound = False
    
    Dim sMasse As Variant
    Dim sFlaeche As Variant
    Dim sVolumen As Variant
    
    sMasse = "0"
    sFlaeche = "0"
    sVolumen = "0"
                
    sMasse = IPropEintraege.Property_lesen(oDoc, "Masse")
    sFlaeche = IPropEintraege.Property_lesen(oDoc, "Flaeche")
    sVolumen = IPropEintraege.Property_lesen(oDoc, "Volumen")
            
    sMasse = Left$(sMasse, InStr(1, sMasse, " ", vbTextCompare))
    sFlaeche = Left$(sFlaeche, InStr(1, sFlaeche, " ", vbTextCompare))
    sVolumen = Left$(sVolumen, InStr(1, sVolumen, " ", vbTextCompare))
    
    If sMasse = "" Then sMasse = "0"
    If sFlaeche = "" Then sFlaeche = "0"
    If sVolumen = "" Then sVolumen = "0"
        
    Dim dMasse As Double
    Dim dFlaeche As Double
    Dim dVolumen As Double
    
    dMasse = Round(CDbl(sMasse), 3)
    dFlaeche = Round(CDbl(sFlaeche), 3)
    dVolumen = Round(CDbl(sVolumen), 3)
    
    'MsgBox (sMasse & " = " & CStr(dMasse) & vbCrLf & _
           sFlaeche & " = " & CStr(dFlaeche) & vbCrLf & _
           sVolumen & " = " & CStr(dVolumen) & vbCrLf)
           
    
    For i = 1 To oParams.Count
        If oParams.Item(i).Name = "Masse" Then
            bMasseFound = True
            oParams.Item(i).Value = dMasse
        End If
        If oParams.Item(i).Name = "Flaeche" Then
            bFlaecheFound = True
            oParams.Item(i).Value = dFlaeche / 100 ' wg intern in cm^2
        End If
        If oParams.Item(i).Name = "Volumen" Then
            bVolumenFound = True
            oParams.Item(i).Value = dVolumen / 1000 ' wg intern in cm^3
        End If
    Next i
    
    'MsgBox ("Masse  : " & CStr(bMasseFound) & vbCrLf & _
           "Flaeche: " & CStr(bFlaecheFound) & vbCrLf & _
           "Volumen: " & CStr(bVolumenFound) & vbCrLf)
    
    If Not bMasseFound Then
        Call oParams.UserParameters.AddByValue("Masse", dMasse, "kg")
    End If
    If Not bFlaecheFound Then
        Call oParams.UserParameters.AddByValue("Flaeche", dFlaeche / 100, "mm mm") ' wg intern in cm^2
    End If
    If Not bVolumenFound Then
        Call oParams.UserParameters.AddByValue("Volumen", dVolumen / 1000, "mm mm mm") ' wg intern in cm^3
    End If
    
    
Set oApplication = Nothing
Set oDoc = Nothing
Set oParams = Nothing


End Sub