Show up-to-date loop length

By Adam Nagy

Through the user interface you can query the length of an entity loop using the Measure Loop tool (Tools >> Measure >> Loop)

If you want to keep showing the length of a specific loop, e.g. in the sketch environment, while editing the geometry, you can do that from your AddIn or VBA. In this case I created a form class in VBA called LengthForm, with a Label (named LengthValue) and a Button (named MarkEntity) on it and used the following code.
Note that this part of the code is for the form that you've just created. Right-click on the LengthForm in the Project window's tree and select View Code - that's where this code should be pasted.

Private WithEvents docEvents As DocumentEvents
Private selEnt As Object

Private Sub docEvents_OnChange( _
ByVal ReasonsForChange As CommandTypesEnum, _
ByVal BeforeOrAfter As EventTimingEnum, _
ByVal Context As NameValueMap, _
HandlingCode As HandlingCodeEnum)
    If BeforeOrAfter <> kAfter Then Exit Sub
    
    LengthValue.Caption = GetLength(selEnt)
End Sub

Private Sub MarkEntity_Click()
    Dim ss As SelectSet
    Set ss = ThisApplication.ActiveDocument.SelectSet
    
    If ss.Count = 0 Then
        Set docEvents = Nothing
        
        LengthValue.Caption = ""
    Else
        Set docEvents = _
            ThisApplication.ActiveDocument.DocumentEvents
            
        Set selEnt = ss(1)
        LengthValue.Caption = GetLength(selEnt)
    End If
End Sub

Function GetLength(ent As Object) As String
    Dim l As Double
    ' Try this
    'l = ThisApplication.MeasureTools.GetLoopLength(ent)
    ' Or this
    l = GetFirstLoopLength(ent)
    
    ' Internal length unit is cm
    GetLength = str(l) + " cm"
End Function

' This is using own logic
Function GetFirstLoopLength(ByVal ent As SketchEntity) As Double
    If ent Is Nothing Then Exit Function
    
    Dim ents As ObjectCollection
    Set ents = ThisApplication.TransientObjects.CreateObjectCollection
    
    Call ents.Add(ent)
    
    Dim success As Boolean
    success = GetFirstLoopRec(ent, ent.EndSketchPoint, ents)
    
    If success Then
        Dim l As Double
        For Each ent In ents
            l = l + ent.Length
        Next
        
        GetFirstLoopLength = l
    End If
End Function

' Return True means we're done
Function GetFirstLoopRec(prev As SketchEntity, sp As SketchPoint, _
ents As ObjectCollection) As Boolean
     Dim first As Object
     Set first = ents(1)
     
     Dim ent As SketchLine
     For Each ent In sp.OwnedBy
        ' If it's not the same as the previuos
        ' entity
        If Not ent Is prev Then
            ' If it's the same as the first entity
            ' then we made a loop
            If ent Is first Then
                GetFirstLoopRec = True
                Exit Function
            End If
            
            Call ents.Add(ent)
            ' Get the sketch point on the other
            ' side of this entity
            If ent.StartSketchPoint Is sp Then
                If GetFirstLoopRec( _
                ent, ent.EndSketchPoint, ents) Then
                    GetFirstLoopRec = True
                    Exit Function
                End If
            Else
                If GetFirstLoopRec( _
                ent, ent.StartSketchPoint, ents) Then
                    GetFirstLoopRec = True
                    Exit Function
                End If
            End If
        End If
     Next
     
     GetFirstLoopRec = False
End Function

Now I can show it modelessly, so that it is always visible. 

Dim lf As LengthForm

Sub ShowLengthForm()
    Set lf = New LengthForm
    lf.Show vbModeless
End Sub

When testing the code, first select a sketch entity that is part of a loop, and then click Mark Entity.

Note: the ThisApplication.MeasureTools.GetLoopLength(ent) function did not always find the loop. My own function seems to work fine, but I did not thoroughly test it.