Public Sub ShowFacePerimeter()
    ' Get the select set of the current document.
    Dim oSS As SelectSet
    Set oSS = ThisApplication.ActiveDocument.SelectSet
    
    ' Make sure a single face is selected.
    If oSS.Count <> 1 Then
        MsgBox "Bitte wählen Sie eine Fläche aus deren Konturen vermessen werden sollen!"
        Exit Sub
    End If
    
    If Not TypeOf oSS.Item(1) Is Face Then
        MsgBox "Bitte wählen Sie eine Fläche aus deren Konturen vermessen werden sollen!"
        Exit Sub
    End If
    
    Dim oFace As Face
    Set oFace = oSS.Item(1)
    
    ' Clear the select set so it doesn't interfere with the highlight.
    ThisApplication.ActiveDocument.SelectSet.Clear
    
    ' Set a reference to the UnitsOfMeasure object to use
    ' in converting the values obtained to the current
    ' document units.  The lengths returned by the API will
    ' always be in centimeters.
    Dim oUOM As UnitsOfMeasure
    Set oUOM = ThisApplication.ActiveDocument.UnitsOfMeasure
    
    ' Create a string that will contain the loop information.
    Dim strResults As String
    
    ' Create the highlight sets.
    Dim oOuterHS As HighlightSet
    Set oOuterHS = ThisApplication.ActiveDocument.CreateHighlightSet
    oOuterHS.Color = ThisApplication.TransientObjects.CreateColor(255, 0, 0)
    Dim oInnerHS As HighlightSet
    Set oInnerHS = ThisApplication.ActiveDocument.CreateHighlightSet
    oInnerHS.Color = ThisApplication.TransientObjects.CreateColor(255, 255, 0)
    
    ' Find the outer loop.
    Dim dOuterLength As Double
    dOuterLength = 0
    Dim oLoop As EdgeLoop
    For Each oLoop In oFace.EdgeLoops
        If oLoop.IsOuterEdgeLoop Then
            Dim oEdge As Edge
            For Each oEdge In oLoop.Edges
                ' Add this edge to the outer highlight set.
                oOuterHS.AddItem oEdge
                
                ' Get the length of the current edge.
                Dim dMin As Double, dMax As Double
                Call oEdge.Evaluator.GetParamExtents(dMin, dMax)
                Dim dLength As Double
                Call oEdge.Evaluator.GetLengthAtParam(dMin, dMax, dLength)
                dOuterLength = dOuterLength + dLength
            Next
            
            ' Add the to the result message string.
            strResults = "Gesamtlänge der äußeren Kontur (rot)= " & oUOM.GetStringFromValue(dOuterLength, kDefaultDisplayLengthUnits) & vbCrLf & vbCrLf
            Exit For
        End If
    Next
    
    ' Iterate through the inner loops.
    Dim iLoopCount As Long
    iLoopCount = 0
    Dim dTotalLength As Double
    For Each oLoop In oFace.EdgeLoops
        Dim dLoopLength As Double
        dLoopLength = 0
        If Not oLoop.IsOuterEdgeLoop Then
            For Each oEdge In oLoop.Edges
                ' Add this edge to the inner highlight set.
                oInnerHS.AddItem oEdge
                
                ' Get the length of the current edge.
                Call oEdge.Evaluator.GetParamExtents(dMin, dMax)
                Call oEdge.Evaluator.GetLengthAtParam(dMin, dMax, dLength)
                dLoopLength = dLoopLength + dLength
            Next
            
            ' Add this loop to the total length.
            dTotalLength = dTotalLength + dLoopLength
            
            ' Add to the result message string.
            iLoopCount = iLoopCount + 1
            strResults = strResults & iLoopCount & ". Innere Kontur " & "; Länge = " & _
                    oUOM.GetStringFromValue(dLoopLength, kDefaultDisplayLengthUnits) & vbCrLf & vbCrLf
        End If
    Next
    
    ' Display the results.
    strResults = strResults & "Gesamtlänge der inneren Konturen (gelb) = " & oUOM.GetStringFromValue(dTotalLength, kDefaultDisplayLengthUnits)
    strResults = strResults & vbCrLf & vbCrLf & "Gesamtlänge aller Konturen (rot + gelb) = " & oUOM.GetStringFromValue(dTotalLength + dOuterLength, kDefaultDisplayLengthUnits)
    MsgBox strResults
End Sub

