形状ｾｯﾄ内の線の長さをExcelｼｰﾄに出力する

前回の結果を「Excelのｼｰﾄに出力したい」と言うことなので
ｺｰﾄﾞを変更しました。

'vba GetCurvesLength_ToExcel
Sub CATMain()
    '選択
    Dim Msg$: Msg = "形状ｾｯﾄを選択して下さい"
    Dim SelItem As SelectedElement: Set SelItem = SelectItem(Msg, Array("HybridBody"))
    If IsNothing(SelItem) Then Exit Sub
    Dim HBody As HybridBody: Set HBody = SelItem.Value
    
    'Partの取得
    Dim Pt As Part: Set Pt = GetParent_Of_T(HBody, "Part")
    
    'HybridShapeFactory取得 - 形状判定の為必要
    Dim Fact As HybridShapeFactory: Set Fact = Pt.HybridShapeFactory
    
    '形状ｾｯﾄ内の直線・円弧・ｽﾌﾟﾗｲﾝを取得
    Dim HSps As HybridShapes: Set HSps = HBody.HybridBodies
    Dim Hsp As HybridShape
    Dim CurveRefs As New Collection
    Dim Ref As Reference
    Dim GeoType&
    For Each Hsp In HSps
        Set Ref = Pt.CreateReferenceFromObject(Hsp)
        GeoType = Fact.GetGeometricalFeatureType(Ref)
        'AutomationManualの記述が間違えやすいが、
        '2-Curve , 3-Line , 4-Circle　になる
        If GeoType >= 2 And GeoType <= 4 Then
            Call CurveRefs.Add(Ref)
        End If
    Next
    
    'Excelのｼｰﾄを取得
    Dim Sheet As Object: Set Sheet = GetExcelSheet
    If IsNothing(Sheet) Then Exit Sub
    
    '測定しつつExcelに書き込み
    Dim CurveLeng#
    Dim I&
    For I = 1 To CurveRefs.Count
        CurveLeng = Pt.Parent.GetWorkbench("SPAWorkbench") _
                             .GetMeasurable(CurveRefs(I)).Length
        Sheet.Cells(I, 1) = CurveRefs(I).DisplayName
        Sheet.Cells(I, 2) = CurveLeng
    Next
    
    '終了
    MsgBox "End"
    DoEvents
    AppActivate "Microsoft Excel"
End Sub

'起動中のExcelのｱｸﾃｨﾌﾞﾌﾞｯｸのｱｸﾃｨﾌﾞｼｰﾄを取得
Private Function GetExcelSheet() As Object
    On Error Resume Next
        Dim Xls As Object
        Set Xls = GetObject(, "Excel.Application")
        Set GetExcelSheet = Xls.ActiveSheet
    On Error GoTo 0
    Err.Clear
End Function