能否通过VBA宏计算Visio多段线（Polyline）的总长度？

我需要通过VBA宏计算Visio中多段线的总长度。目前已开发的宏可正确计算直线和弧线的长度，但对**使用直线工具连续点击前一段端点生成的折线（多段线）**计算失效，且宏会周期性崩溃，现确认该需求是否可行。

以下是当前编写的代码：

'=====================================================================
' Macro: ShowSelectedShapeLengthV2
' Purpose: Returns the total length of the selected shape(s) and
'          displays it in the current page’s units (mm, cm, in, …)
'=====================================================================
Sub ShowSelectedShapeLengthV2()
    Dim sel As Visio.Selection
    Dim i As Long
    Dim totalLengthIU As Double          ' internal units = inches
    Dim pageUnits As String
    Dim totalLength As Double
    
    Set sel = Application.ActiveWindow.Selection
    
    If sel.Count = 0 Then
        MsgBox "Please select at least one shape.", vbExclamation, "No selection"
        Exit Sub
    End If
    
    '--- sum the length of every selected shape -----------------------
    totalLengthIU = 0#
    For i = 1 To sel.Count
        totalLengthIU = totalLengthIU + GetShapeLength(sel(i))
    Next i
    
    If totalLengthIU = 0 Then
        MsgBox "None of the selected shapes have a measurable outline.", _
               vbExclamation, "No length found"
        Exit Sub
    End If
    
    '--- 1?? Get the **actual** page unit -----------------------------
    pageUnits = GetCurrentPageUnits()
    
    '--- ?? Convert from internal units (inches) to that unit -------
    totalLength = Application.ConvertResult(totalLengthIU, visInches, pageUnits)
    
    '--- 3?? Show the result -----------------------------------------
    MsgBox "Total length of the selected shape(s): " & _
           Format(totalLength, "#,##0.00") & " " & pageUnits, _
           vbInformation, "Shape Length"
End Sub

'ShapeLength
' Returns the length of a single shape in internal units (inches)
'=====================================================================
Private Function GetShapeLength(vsh As Visio.Shape) As Double
    Dim shapeLength As Double
    Dim errNum As Long
    
    '--- A?? Group handling -------------------------------------------
    If vsh.Type = visTypeGroup Then
        Dim mem As Visio.Shape
        For Each mem In vsh.GroupMembers
            shapeLength = shapeLength + GetShapeLength(mem)
        Next mem
        GetShapeLength = shapeLength
        Exit Function
    End If
    
    '--- B?? Try the built-in CurveLength property --------------------
    On Error Resume Next
    shapeLength = vsh.CurveLength               ' internal units (inches)
    errNum = Err.Number
    On Error GoTo 0
    
    If errNum = 0 And shapeLength > 0 Then
        GetShapeLength = shapeLength
        Exit Function
    End If
    
    '--- C?? Plain line (Begin/End cells) -----------------------------
    If vsh.SectionExists(visSectionObject, visExistsLocally) Then
        Dim bX As Double, bY As Double, eX As Double, eY As Double
        
        On Error Resume Next
        bX = vsh.CellsU("BeginX").ResultIU
        bY = vsh.CellsU("BeginY").ResultIU
        eX = vsh.CellsU("EndX").ResultIU
        eY = vsh.CellsU("EndY").ResultIU
        errNum = Err.Number
        On Error GoTo 0
        
        If errNum = 0 Then
            shapeLength = Sqr((eX - bX) ^ 2 + (eY - bY) ^ 2)   ' Euclidean distance
            GetShapeLength = shapeLength
            Exit Function
        End If
    End If
    
    '--- D?? Connectors (same Begin/End cells) ------------------------
    If vsh.Type = visTypeConnector Then
        Dim cBX As Double, cBY As Double, cEX As Double, cEY As Double
        
        On Error Resume Next
        cBX = vsh.CellsU("BeginX").ResultIU
        cBY = vsh.CellsU("BeginY").ResultIU
        cEX = vsh.CellsU("EndX").ResultIU
        cEY = vsh.CellsU("EndY").ResultIU
        errNum = Err.Number
        On Error GoTo 0
        
        If errNum = 0 Then
            shapeLength = Sqr((cEX - cBX) ^ 2 + (cEY - cBY) ^ 2)
            GetShapeLength = shapeLength
            Exit Function
        End If
    End If
    
    '--- E?? No measurable outline ------------------------------------
    GetShapeLength = 0#
End Function

'=====================================================================
' Helper: GetCurrentPageUnits
' Returns a string such as "mm", "cm", "in", "pt", "ft"
'=====================================================================
Private Function GetCurrentPageUnits() As String
    Dim unitStr As String
    
    On Error Resume Next
    ' Try the Units cell on the active page’s ShapeSheet
    unitStr = Application.ActiveWindow.Page.PageSheet.CellsU("Units").ResultStr("")
    On Error GoTo 0
    
    If Len(unitStr) = 0 Then
        ' Fallback – use the document’s default unit (returns a constant)
        Dim defUnit As Long
        On Error Resume Next
        defUnit = Application.ActiveDocument.pageUnits
        On Error GoTo 0
        
        Select Case defUnit
            Case visInches:   unitStr = "in"
            Case visCentimeters: unitStr = "cm"
            Case visMillimeters: unitStr = "mm"
            Case visPoints:   unitStr = "pt"
            Case visFeet:     unitStr = "ft"
            Case Else
                ' If we still have nothing, default to millimetres – the
                ' most common metric unit in Visio drawings.
                unitStr = "mm"
        End Select
    End If
    
    GetCurrentPageUnits = unitStr
End Function

测试结果：选中目标多段线后运行宏，弹出提示框显示“None of the selected shapes have a measurable outline”，说明多段线长度未被正确计算。

内容的提问来源于stack exchange，提问作者SSilk