'Prozeduraufruf: ActiveDoc ist ein Sheetmetal- oder Part-Dokument
GetDimensions ActiveDoc
GetFeatures ActiveDoc

'Prozedur zum Auslesen der Dimensionen
Public Sub GetDimensions(ByVal ActiveDoc As Object)
Dim oProfSet As SolidEdgePart.ProfileSet
Dim oProf As SolidEdgePart.Profile
Dim oDim As SolidEdgeFrameworkSupport.Dimension
Dim i As Integer, k As Integer, l As Integer
Dim s As String

  s = "Dimensionen:" & vbCrLf
  
  For i = 1 To ActiveDoc.ProfileSets.Count
    Set oProfSet = ActiveDoc.ProfileSets(i)
    For k = 1 To oProfSet.Profiles.Count
      Set oProf = oProfSet.Profiles(k)
      For l = 1 To oProf.Dimensions.Count
        Set oDim = oProf.Dimensions(l)
        s = s & vbCrLf & oDim.Name & ":" & oDim.Value
      Next
    Next
  Next
  Set oDim = Nothing
  Set oProf = Nothing
  Set oProfSet = Nothing
  
  MsgBox s

End Sub

'Prozedur zum Auslesen der Features(Name und Typ) und 
'Dimensionen von Ausprägungen (Achtung: Fehler bei Ausprägungen mit mehreren Profilen)

Public Sub GetFeatures(ByVal ActiveDoc As Object)
Dim oFeat As Object
Dim oExtProt As SolidEdgePart.ExtrudedProtrusion
Dim oDim As SolidEdgeFrameworkSupport.Dimension
Dim s As String, F As String
Dim i As Integer, k As Integer

  On Error Resume Next

  s = "Features: " & vbCrLf
  For i = 1 To ActiveDoc.Models(1).Features.Count
    Set oFeat = ActiveDoc.Models(1).Features(i)
    If oFeat.Type = igExtrudedProtrusionFeatureObject Then
      Set oExtProt = oFeat
      F = "Ausprägung: " & oExtProt.Name & vbCrLf
      For k = 1 To oExtProt.Profile.Dimensions.Count
        F = F & vbCrLf & oExtProt.Profile.Dimensions(k).Name & ": " _
           & oExtProt.Profile.Dimensions(k).Value
      Next
    End If
    s = s & oFeat.Name & vbTab & oFeat.Type & vbCrLf
  Next
  Set oDim = Nothing
  Set oFeat = Nothing
  Set oExtProt = Nothing
  MsgBox s & vbCrLf & F
End Sub

'Nach dem Umbenennen von Features in SE wird der Name aus der EdgeBar verwendet.