'--------------------------------------------------------------------------------------------------

  
 Public Sub Properties_auslesen()
  
      ' Declare the Application object
    Dim oApplication As Inventor.Application

    ' Obtain the Inventor Application object.
    ' This assumes Inventor is already running.
    Set oApplication = GetObject(, "Inventor.Application")

    ' Set a reference to the active document.
    ' This assumes a document is open.
    Dim oDoc As Document
    Set oDoc = oApplication.ActiveDocument
    
  
    Call Doc_Properties_auslesen(oDoc)
  
  
  End Sub
  
   
'--------------------------------------------------------------------------------------------------

 
  Private Sub Doc_Properties_auslesen(oDoc As Document)
  
  
      
    ' Obtain the PropertySets collection object
    Dim oPropSets As PropertySets
    Set oPropSets = oDoc.PropertySets
 
  
    ' Iterate through all the PropertySets one by one using for loop
    Dim oPropSet As PropertySet
    
    Dim oProperty As Property
    
    Debug.Print
    Debug.Print "Properties in " & oDoc.DisplayName
    Debug.Print
    Debug.Print "==============================================================================="
    Debug.Print
    
    For Each oPropSet In oPropSets
    
        ' Obtain the DisplayName of the PropertySet
        Debug.Print "Display name: " & oPropSet.DisplayName

        ' Obtain the InternalName of the PropertySet
        Debug.Print "Internal name: " & oPropSet.InternalName

        ' Write a blank line to separate each pair.
        Debug.Print
   ' Next

    ' Get a reference to the "Design Tracking Properties" PropertySet
    'Dim oPropSet As PropertySet
    'Set oPropSet = oPropsets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
 
  
    'Dim oPropSet As PropertySet
    'For Each oPropSet In oPropsets
        ' Iterate through all the Properties in the current set.
        For Each oProperty In oPropSet
        
            On Error Resume Next
            
            ' Obtain the Name of the Property
            Dim sName As String
            sName = oProperty.name

            ' Obtain the Value of the Property
            Dim vValue As Variant
            vValue = oProperty.Value

            ' Obtain the Expression of the Property
            Dim vExpression As Variant
            vExpression = oProperty.Expression

            ' Obtain the PropertyId of the Property
            Dim PropertyId As Long
            PropertyId = oProperty.PropId
            
            Debug.Print sName; Tab(35); ": " & vValue;
            If VBA.Left$(CStr(vExpression), 1) = "=" Then
                Debug.Print Tab(70); vExpression
            Else
                Debug.Print
            End If
            
            
            If Err.Number <> 0 Then
                Err.Clear
            End If
        Next
        
        Debug.Print
        Debug.Print "- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -"
        Debug.Print
    
    Next
  
  
'--------------------------------------------------------------------------------------------------