サーフェスの重心をDrawのﾃｰﾌﾞﾙに書き込む2

こちらの続きです。
サーフェスの重心をDrawのﾃｰﾌﾞﾙに書き込む - C#ATIA

ちょっとお望みの状態では無かった様で、修正しました。

'Drawからマクロをスタートし、Partのサーフェスを指定
'Drawにﾃｰﾌﾞﾙを新作し、重心位置を書き込む2

Option Explicit

Sub CATMain()

    'ﾄﾞｷｭﾒﾝﾄのﾁｪｯｸ
    If Not CanExecute("DrawingDocument") Then Exit Sub
    
    'ｻｰﾌｪｽ選択
    Dim msg As String
    msg = "重心を求めるｻｰﾌｪｽを指定してください / ESCキー ｷｬﾝｾﾙ"
    
    Dim elm As SelectedElement
    Set elm = SelectElement4(msg, msg, Array("HybridShape")) 'ここ修正
    
    '重心
    Dim cog As Variant
    cog = GetCog(elm.Value) 'ここ修正
    
    'ﾃｰﾌﾞﾙ作成
    Dim tb As DrawingTable
    Set tb = InitDrawTable
    
    'ﾃｰﾌﾞﾙに書き込み
    Call WriteTable(tb, elm.Value.Name, Join(cog, ",")) 'ここ修正
    
    'fin
    MsgBox "Done"

End Sub

'ﾃｰﾌﾞﾙ書き込み
Private Sub WriteTable( _
    ByVal tb As DrawingTable, _
    ByVal faceName As String, _
    ByVal cog As String)
    
    Call tb.SetCellString(1, 1, faceName)
    Call tb.SetCellString(1, 2, cog)

End Sub

'重心 -ﾓﾛﾓﾛ修正
Private Function GetCog( _
    ByVal hs As HybridShape) _
    As Variant
    
    Dim doc As PartDocument
    Set doc = GetParent_Of_T(hs, "PartDocument")
    
    Dim spa As Object
    Set spa = doc.GetWorkbench("SPAWorkbench")
    
    Dim pt As part
    Set pt = doc.part
    
    Dim ref As Reference
    Set ref = pt.CreateReferenceFromObject(hs)
    
    Dim mes As Variant ' Measurable
    Set mes = spa.GetMeasurable(ref)
    
    Dim cog(2) As Variant
    mes.GetCog cog
    
    GetCog = cog
    
End Function

'T型のParent取得 -追加
Private Function GetParent_Of_T( _
    ByVal aoj As AnyObject, _
    ByVal t As String) _
    As AnyObject
    
    Dim aojName As String
    Dim parentName As String
    
    On Error Resume Next
        aojName = aoj.Name
        parentName = aoj.Parent.Name
    On Error GoTo 0

    If typename(aoj) = typename(aoj.Parent) And _
       aojName = parentName Then
        Set GetParent_Of_T = Nothing
        Exit Function
    End If
    If typename(aoj) = t Then
        Set GetParent_Of_T = aoj
    Else
        Set GetParent_Of_T = GetParent_Of_T(aoj.Parent, t)
    End If
End Function

'ｻｰﾌｪｽか? -追加
Private Function IsSurface( _
    ByVal sp As HybridShape) _
    As Boolean
    
    Dim pt As part
    Set pt = GetParent_Of_T(sp, "Part")
    
    Dim fact As HybridShapeFactory
    Set fact = pt.HybridShapeFactory
    
    Dim ref As Reference
    Set ref = pt.CreateReferenceFromObject(sp)
    
    IsSurface = IIf(fact.GetGeometricalFeatureType(ref) = 5, True, False)
    
End Function

'SelectElement4 -ﾓﾛﾓﾛ修正
Private Function SelectElement4( _
    ByVal msg1 As String, _
    ByVal msg2 As String, _
    ByVal filter As Variant) _
    As SelectedElement
    
    Dim sel As Variant
    Set sel = CATIA.ActiveDocument.selection
    Dim targetDoc As Variant 'Document 型指定Ng
    
    Do
        sel.Clear
        Select Case sel.SelectElement4(filter, msg1, msg2, _
                                       True, targetDoc)
            Case "Cancel", "Undo", "Redo"
                Exit Function
        End Select
        
        Dim tgtSel As selection
        Set tgtSel = targetDoc.selection
        
        Dim elm As SelectedElement
        Set elm = tgtSel.Item2(1)
        
        'ｻｰﾌｪｽﾁｪｯｸ
        If IsSurface(elm.Value) Then
            Exit Do
        Else
            MsgBox "ｻｰﾌｪｽﾀｲﾌﾟを選択してください!!"
        End If
    Loop
    
    Set SelectElement4 = elm
    
    sel.Clear
    tgtSel.Clear
End Function

'アクティブなビューにDrawﾃｰﾌﾞﾙの作成
Private Function InitDrawTable() _
    As DrawingTable
    
    Dim dwDoc As DrawingDocument
    Set dwDoc = CATIA.ActiveDocument
    
    Dim vi As DrawingView
    Set vi = dwDoc.Sheets.ActiveSheet.views.ActiveView

    Set InitDrawTable = vi.Tables.Add( _
        -100#, _
        200#, _
        3, _
        2, _
        8#, _
        20#)
        
End Function
    
'ｴﾗｰ回避の為のﾄﾞｷｭﾒﾝﾄﾀｲﾌﾟﾁｪｯｸ
Private Function CanExecute( _
    ByVal docTypes As Variant) _
    As Boolean
    
    CanExecute = False
    
    If CATIA.Windows.Count < 1 Then
        MsgBox "ﾌｧｲﾙが開かれていません"
        Exit Function
    End If
    
    If VarType(docTypes) = vbString Then docTypes = Split(docTypes, ",")
    
    Dim ErrMsg As String
    ErrMsg = "ﾌｧｲﾙのﾀｲﾌﾟが異なります。" + vbNewLine + "(" + Join(docTypes, ",") + " のみです)"
    
    Dim actDoc As Document
    On Error Resume Next
        Set actDoc = CATIA.ActiveDocument
    On Error GoTo 0
    If actDoc Is Nothing Then
        MsgBox ErrMsg, vbExclamation + vbOKOnly
        Exit Function
    End If
    
    If UBound(filter(docTypes, typename(actDoc))) < 0 Then
        MsgBox ErrMsg, vbExclamation + vbOKOnly
        Exit Function
    End If
    
    CanExecute = True
End Function

こちらのKCLを導入して頂くと、もっとコードが短くなります。
非常に個人的なCATVBA用ﾗｲﾌﾞﾗﾘ - C#ATIA