2D属性リンクを扱いたい8

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

こちらの「GetLinksInfo.bas」でリンク情報が手に入ったので、
セルのオブジェクト名を書き込むのをやめて、リンク情報を書き込む
ことにします。
ﾌｧｲﾙ間ﾘﾝｸの取得9 - C#ATIA

'vba CheckAttributeLink Ver0.0.1
'using-'KCL0.0.13' 'GetLinksInfo ver0.0.2'  by Kantoku
'指定したDrawTableの隣に属性ﾘﾝｸ情報ﾃｰﾌﾞﾙを作成する

Option Explicit

'元ﾃｰﾌﾞﾙとのﾏｰｼﾞﾝ距離
Private Const MARGIN_X = 10#

Sub CATMain()
    Dim msg As String
    
    #If VBA7 And Win64 Then
        'ok
    #Else
        msg = "VBA環境が VBA7 & Win64 では無い為" & vbCrLf & _
            "正しく処理正しく処理出来ません!" & vbCrLf & _
            "中止します"
        MsgBox msg, vbExclamation
        Exit Sub
    #End If
    
    'ﾄﾞｷｭﾒﾝﾄのﾁｪｯｸ
    If Not CanExecute("DrawingDocument") Then Exit Sub
    
    Dim dDoc As DrawingDocument
    Set dDoc = CATIA.ActiveDocument
    
    'ﾃｰﾌﾞﾙ選択
    msg = "テーブル選択/ESCキー中止"
    
    Dim tblOri As DrawingTable
    Set tblOri = KCL.SelectItem(msg, "DrawingTable")
    If tblOri Is Nothing Then Exit Sub
    
    KCL.SW_Start
    
    '属性ﾘﾝｸ情報取得
    Dim links As Variant
    links = GetLinkInfo(tblOri)
    If UBound(links) < 1 Then
        MsgBox "ﾘﾝｸ情報が無い、又は取得に失敗しました"
        Exit Sub
    End If
    
    'ﾋﾞｭｰ取得
    Dim vi As DrawingView
    Set vi = tblOri.Parent.Parent
    
    'ﾃｰﾌﾞﾙｺﾋﾟﾍﾟ
    Dim tblNew As DrawingTable
    Set tblNew = CopyTable(tblOri, vi)
    If tblNew Is Nothing Then
        MsgBox "ﾃｰﾌﾞﾙのｺﾋﾟﾍﾟに失敗しました"
        Exit Sub
    End If
    
    '描写停止
    tblOri.ComputeMode = CatTableComputeOFF
    tblNew.ComputeMode = CatTableComputeOFF
    
    'ﾃｰﾌﾞﾙ幅取得
    Dim moveX As Double
    moveX = GetColumnSizeAll(tblNew)
    tblNew.X = (tblNew.X + moveX + MARGIN_X) / vi.scale2
    
    'ﾃｰﾌﾞﾙにｵﾌﾞｼﾞｪｸﾄ名記入
    'WriteCellName tblNew
    
    'ｾﾙ辞書作成
    Dim cellDic As Object
    Set cellDic = InitCellDic(tblOri, tblNew)
    If cellDic.count < 1 Then
        MsgBox "ｾﾙ情報の取得に失敗しました"
        GoTo fin
    End If
    
    'ﾘﾝｸ情報書き込み
    Call PushInfo(cellDic, links)
    
fin:
    '描写
    tblOri.ComputeMode = CatTableComputeON
    tblNew.ComputeMode = CatTableComputeON
    
    MsgBox "done : " & KCL.SW_GetTime & "s"
    
End Sub

Private Sub PushInfo( _
    ByVal dic As Object, _
    ByVal infos As Variant)
    
    Dim i As Long
    Dim dt As DrawingText
    For i = 0 To UBound(infos)
        If Not dic.Exists(infos(i)(0)) Then GoTo continue
        
        Set dt = dic.Item(infos(i)(0))
        dt.Text = dt.Text & vbCrLf & ConvPrmValue(infos(i)(1))
        dt.TextProperties.Bold = 1
continue:
    Next
    
End Sub

'先頭部(ﾊﾟｰﾄNo)削除
Private Function ConvPrmValue( _
    ByVal txt As String) _
    As String
    
    Dim idx As Long
    idx = InStr(txt, "\")
    
    If idx > 0 Then
        txt = Mid(txt, idx + 1)
    End If
    
    ConvPrmValue = txt
    
End Function


'ｾﾙの辞書作成 - ついでに初期化
'return:dic(key(string)-objName,value(drawtxt)-obj
Private Function InitCellDic( _
    ByVal tbOri As DrawingTable, _
    ByVal tbNew As DrawingTable) As Object
    
    Dim dic As Object
    Set dic = KCL.InitDic()
    
    Dim r As Long, c As Long
    Dim dt As DrawingText
    
    With tbNew
        For r = 1 To .NumberOfRows
            For c = 1 To .NumberOfColumns
                'Existsしなくても大丈夫なはず
                Set dt = .GetCellObject(r, c)
                dt.TextProperties.Bold = 0
                dic.Add tbOri.GetCellObject(r, c).Name, dt
            Next
        Next
    End With
    
    Set InitCellDic = dic
    
End Function


Private Function GetLinkInfo( _
    ByVal tb As DrawingTable) As Variant
    
    Dim sel As selection
    Set sel = CATIA.ActiveDocument.selection
    
    CATIA.HSOSynchronized = False
    
    sel.Clear
    sel.Add tb
    
    Dim ary As Variant
    ary = GetLinksInfo.GetInfo()
    
    sel.Clear
    
    CATIA.HSOSynchronized = True
    
    GetLinkInfo = ary
    
End Function



Private Function CopyTable( _
    ByVal tb As DrawingTable, _
    ByVal vi As DrawingView) _
    As DrawingTable
    
    Dim sel As selection
    Set sel = CATIA.ActiveDocument.selection
        
    CATIA.HSOSynchronized = False
    
    With sel
        .Clear
        .Add tb
        .Copy
        .Clear
        .Add vi
        .Paste
        Set CopyTable = .Item2(1).Value
        .Clear
    End With
    
    CATIA.HSOSynchronized = True
    
End Function

Private Function GetColumnSizeAll( _
    ByVal tb As DrawingTable) As Double
    
    Dim sumClm As Double
    sumClm = 0#
    
    Dim i As Long
    For i = 1 To tb.NumberOfColumns
        sumClm = sumClm + tb.GetColumnSize(i)
    Next
    
    GetColumnSizeAll = sumClm
    
End Function

前回同様、右側に新たなﾃｰﾌﾞﾙを作ります。
セル内の属性ﾘﾝｸを持っているものは、フォントのBoldがON状態に
なり、元の値の下に属性リンクのパスが書き込まれます。
パスをそのまま書き込みだと長ったらしい為、
PartNo以降のパスとしています。

劇的に確認作業が楽になりましたよ！
客先環境下では諦めた･･･。