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

御相談頂いた、サーフェスの重心をDrawのテーブルに書き込むサンプルです。

Drawからスタートし、途中でPartに切り替えて何かを指定しなければならない
マクロの場合、SelectElement4を使用する必要が有ります。（他の手法は知りません）

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

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("Face"))
    
    '重心
    Dim cog As Variant
    cog = GetCog(elm.Value, elm.Document)
    
    'ﾃｰﾌﾞﾙ作成
    Dim tb As DrawingTable
    Set tb = InitDrawTable
    
    'ﾃｰﾌﾞﾙに書き込み
    Call WriteTable(tb, elm.Value.DisplayName, 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 face As face, _
    ByVal doc As Document) _
    As Variant
    
    Dim spa As Object
    Set spa = doc.GetWorkbench("SPAWorkbench")
    
    Dim mes As Variant ' Measurable
    Set mes = spa.GetMeasurable(face)
    
    Dim cog(2) As Variant
    mes.GetCog cog
    
    GetCog = cog
    
End Function

'SelectElement4
Private Function SelectElement4( _
    ByVal msg1 As String, _
    ByVal msg2 As String, _
    ByVal filter As Variant) _
    As AnyObject
    
    Dim sel As Variant
    Set sel = CATIA.ActiveDocument.selection
    Dim targetDoc As Variant 'Document 型指定Ng
    
    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
    Set SelectElement4 = tgtSel.Item2(1)
    
    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

正直な所、使いにくいような気もしていますが、
コード的なXXX　を質問されるより、全体としてどんな処理をしたいのか？
まで伝えて頂いた方が、手間が少ない上、コードもすっきりします。