Sub Skizzen_Check3()
'Imports Inventor.ConstraintStatusEnum
'Imports Inventor.GeometryMoveableStatusEnum

Dim oDoc As Inventor.Document
Set oDoc = ThisApplication.ActiveDocument

Dim oSketchEntity As Inventor.SketchEntity
Dim oSketches As Object
Dim oSketch As Inventor.Sketch
Dim oCompDef As Inventor.PartComponentDefinition
Set oCompDef = oDoc.ComponentDefinition

Dim oSketchEntities As Inventor.SketchEntitiesEnumerator

Dim bol_ÜberBest As Boolean
Dim bol_UnterBest As Boolean
Dim bol_UnbekBest As Boolean
Dim Skizzen_Fehler As Boolean
Dim i As Integer

'51713  kFullyConstrainedConstraintStatus
'51714  kUnderConstrainedConstraintStatus
'51715  kOverConstrainedConstraintStatus
'51716  kUnknownConstraintStatus
'53505  Inventor.GeometryMoveableStatusEnum.kFreeToMoveGeometryMoveableStatus

'Skizzenüberprüfung nur, wenn keine Teil aus Contentcenter
If oCompDef.IsContentMember = False Then
    'Skizzen voll bestimmt?
    Set oSketches = oCompDef.Sketches 'Skizzen aus dem Bauteil holen
    If oSketches.Count > 0 Then
        For i = 1 To oSketches.Count 'Each oSketch In oSketches
        Skizzen_Fehler = False
            If oSketches.Item(i).Profiles.Count > 0 Then  'Profil-Skizze
                Set oSketchEntities = oSketches.Item(i).SketchEntities 'Skizzeneinträge holen
                For Each oSketchEntity In oSketchEntities
                    If oSketchEntity.ConstraintStatus <> 51713 Then    'kFullyConstrainedConstraint
                        If oSketchEntity.ConstraintStatus = 51715 Then 'kOverConstrainedConstraint
                            'Überbestimmung
                            'MsgBox (" Skizze " & i & " ist überbestimmt")
                            'Skizzen_Fehler = True
                            bol_ÜberBest = True
                        End If
                                               
                        If (oSketchEntity.ConstraintStatus = 51714) Then  'kUnderConstrainedConstraint
                            'Unterbestimmung
                            Skizzen_Fehler = True
                            bol_UnterBest = True
                        End If
            
                        'If oSketchEntity.ConstraintStatus = 51716 Then  'kUnknownConstraint
                            'Unbekannt bestimmt
                            'Skizzen_Fehler = True
                            'bol_UnbekBest = True
                        'End If
                    End If '<> 51713
                Next
            End If 'Profiles.Count > 0
            
            If oSketches.Item(i).Profiles.Count = 0 Then  'Bohrungspunkte
                Set oSketchEntities = oSketches.Item(i).SketchEntities 'Skizzeneinträge holen
                For Each oSketchEntity In oSketchEntities
                        If (oSketchEntity.[_GeometryMoveableStatus] = 53505) Then
                            'MsgBox (" Skizze " & i & " ist unterbestimmt")
                            Skizzen_Fehler = True
                            bol_UnterBest = True
                        End If
                Next
            End If 'Profiles.Count = 0
            
            If Skizzen_Fehler Then
                MsgBox (" Skizze " & i & " ist unterbestimmt")
                Dim sk As PlanarSketch
                Set sk = oSketches.Item(i)
                sk.Edit  'unterbestimmte Skizze zum Bearbeiten öffnen
                Exit Sub
            End If 'Skizzen_Fehler
                        
        Next
    End If
End If
MsgBox ("Skizzen überprüft - alle ok")
End Sub 'Skizzen_Check3