2D属性リンクを扱いたい5 属性ﾘﾝｸ付き座標ﾃｰﾌﾞﾙ

こちらの続きです。
2D属性リンクを扱いたい4 - C#ATIA

やっと属性リンク付き座標テーブルが出来ました。

'vba AttributeLinkTable Ver0.0.1 using-'KCL0.0.12'  by Kantoku
'属性リンク付き座標テーブル-平面上の点のみ対応

Private Const TITLE = "AttributeTable"  'ﾃｰﾌﾞﾙのﾀｲﾄﾙ
Private Const KEY_H = "H"               'ﾊﾟﾗﾒｰﾀ用Hｷｰ
Private Const KEY_V = "V"               'ﾊﾟﾗﾒｰﾀ用Vｷｰ
Private Const ROWSIZE = 10              'ﾃｰﾌﾞﾙ初期行高さ
Private Const COLUMNSIZE = 35           'ﾃｰﾌﾞﾙ初期列幅

Sub CATMain()

    'ﾄﾞｷｭﾒﾝﾄのﾁｪｯｸ
    If Not CanExecute("DrawingDocument") Then Exit Sub
    
    Dim dDoc As DrawingDocument
    Set dDoc = CATIA.ActiveDocument
    
    'ﾋﾞｭｰ選択
    Dim msg As String
    msg = "ﾃｰﾌﾞﾙを作成する、ﾋﾞｭｰを選択してください /ESC-終了"
    
    Dim vi As DrawingView
    Set vi = KCL.SelectItem(msg, "DrawingView")
    If vi Is Nothing Then Exit Sub
    
    '形状ｾｯﾄ選択
    msg = "平面上の点を含んだ、形状ｾｯﾄを選択してください /ESC-終了"
    
    Dim hBdy As HybridBody
    Set hBdy = SelectItem4(msg, msg, Array("HybridBody"))
    If hBdy Is Nothing Then Exit Sub
    
    'ﾘﾝｸPart取得
    Dim lnkPt As Part
    Set lnkPt = KCL.GetParent_Of_T(hBdy, "Part")
    If lnkPt Is Nothing Then
        MsgBox "形状ｾｯﾄのPartが取得できませんでした"
        Exit Sub
    End If
    
    'ﾊﾟﾗﾒｰﾀ名取得
    Dim prms As Variant
    prms = GetParamNames(hBdy)
    If IsEmpty(prms) Then
        msg = "処理すべき点が含まれていませんでした" & vbCrLf & _
            "（平面上の点のみ対応してます）"
        MsgBox msg
        Exit Sub
    End If
    
    'ﾃｰﾌﾞﾙ作成
    Dim tbl As DrawingTable
    Set tbl = vi.Tables.Add(0, 0, 1, 1, ROWSIZE, COLUMNSIZE) '仮
    
    'ﾃｰﾌﾞﾙに書き込み
    Call PushData2Table(tbl, prms, lnkPt.Parameters)
    
    MsgBox "done"
    
End Sub

'ﾃｰﾌﾞﾙに投げ込む
Private Sub PushData2Table( _
    ByVal tbl As DrawingTable, _
    ByVal pntprms As Variant, _
    ByVal prms As Parameters)
    
    'Column追加
    Dim clmcnt As Long
    clmcnt = UBound(pntprms(0))
    
    Dim c As Long
    For c = 0 To clmcnt - 1
        Call tbl.AddColumn(1)
    Next
    
    'row追加+ﾀｲﾄﾙ分
    Dim rowcnt As Long
    rowcnt = UBound(pntprms)
    
    Dim r As Long
    For r = 0 To rowcnt
        Call tbl.AddRow(1)
    Next
    
    'タイトル
    Dim titles As Variant
    titles = Array(TITLE, KEY_H, KEY_V)
    
    Dim dt As DrawingText
    For c = 0 To clmcnt
        Set dt = tbl.GetCellObject(1, c + 1)
        dt.Text = titles(c)
    Next
    
    '書き出し
    For r = 0 To rowcnt
        Set dt = tbl.GetCellObject(r + 2, 1)
        dt.Text = pntprms(r)(0)
        
        For c = 1 To clmcnt
            Set dt = tbl.GetCellObject(r + 2, c + 1)
            Call dt.InsertVariable(0, 0, prms.Item(pntprms(r)(c)))
        Next
    Next
    
End Sub

'形状ｾｯﾄ内の点からﾊﾟﾗﾒｰﾀ名を取得
Private Function GetParamNames( _
    ByVal hBdy As HybridBody) As Variant
    
    Dim shps As HybridShapes
    Set shps = hBdy.HybridShapes
    
    'HybridShapePointOnPlaneのみ
    Dim lst As Collection
    Set lst = New Collection
    
    Dim shp As HybridShape
    Dim i As Long
    For i = 1 To shps.Count
        If Not typename(shps.Item(i)) = "HybridShapePointOnPlane" Then
            GoTo continue
        End If
        
        lst.Add shps.Item(i)
continue:
    Next
    
    If lst.Count < 1 Then Exit Function '点なし
    
    
    'HVﾊﾟﾗﾒｰﾀ名を取得
    Dim pt As Part
    Set pt = KCL.GetParent_Of_T(hBdy, "Part")
    
    Dim prms As Parameters
    Set prms = pt.Parameters
    
    Dim ary() As Variant
    ReDim ary(lst.Count - 1)
    
    Dim baseName As String
    Dim prmH As String
    Dim prmV As String
    Dim cnt As Long
    cnt = -1
    For i = 1 To lst.Count
        baseName = prms.GetNameToUseInRelation(lst.Item(i))
        prmH = Left(baseName, Len(baseName) - 1) & _
            "\" & KEY_H & Right(baseName, 1)
        prmV = Left(baseName, Len(baseName) - 1) & _
            "\" & KEY_V & Right(baseName, 1)
        
        If ExistsParam(prmH, prms) And ExistsParam(prmV, prms) Then
            ary(i - 1) = Array(lst.Item(i).name, prmH, prmV)
            cnt = cnt + 1
        End If
    Next
    
    If cnt < 0 Then Exit Function '点なし
    
    If Not UBound(ary) = cnt Then
        ReDim Preserve ary(cnt)
    End If
    
    GetParamNames = ary
    
End Function

'ﾊﾟﾗﾒｰﾀ存在してる?
Private Function ExistsParam( _
    ByVal key As String, _
    ByVal params As Parameters) As Boolean
        
    Dim prm As Parameter
    
    Err.Number = 0
    On Error Resume Next
        Set prm = params.Item(key)
    On Error GoTo 0
    
    ExistsParam = IIf(Err.Number = 0, True, False)

End Function

'SelectElement4
'pram:filter-AryVariant(string)
Private Function SelectItem4( _
    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, _
                                   False, targetDoc)
        Case "Cancel", "Undo", "Redo"
            Exit Function
    End Select
    
    Dim tgtSel As selection
    Set tgtSel = targetDoc.selection
    Set SelectItem4 = tgtSel.Item2(1).Value
    
    sel.Clear
    tgtSel.Clear
End Function

対象は平面上の点のみです。

まず、座標テーブルを作成するDrawと座標を取得するPartを開きます。

Draw側をアクティブにしてマクロをスタート。
・まず、テーブルを作成するビューを選択。
・続いてPart側をアクティブにし、座標を取得する形状セットを選択。
で終わりです。

実行後の状態はこんな感じです。

属性リンクが付いてます！　・・・どれがどのセルか分かんないのですが。
赤印部分は点の名前です。

・単位要らない　：　プロパティのチェックを外すのはマクロでは無理っぽいです。
・自動ﾌｨｯﾄしたい　：　ここもマクロでは無理っぽいです。
　　
・フォントが気に入らない　：　個人的にはSSS4にしたいのですが、客先環境では
　許されないので、デフォルトのままです。（フォント類はマクロでは修正してません）

ここがゴールじゃない上に、もう業務ではチマチマやってしまいました。
（要は間に合わなかった）
属性リンクの確認も未だやりにくいまま。
それ以上に、何でこんなにテーブルって扱いにくいんだろうとも思ってます。

タイミングが良すぎるぐらいなトピが出来ています。
Drawing text with Attribute link in VB6 - DASSAULT: CATIA products - Eng-Tips
みんな属性リンクに困っているんだな、きっと。