Show up-to-date loop length

<?xml encoding=”UTF-8″>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.