形状セット内の点の名前をDrawに配置する

タイトル異なりますが、実質こちらの続きです。
Drawで連番の文字を作る - C#ATIA

先日作ったものが、やっぱり使い勝手が悪いです。
正直な所、使いたい場面はこんな感じです。

形状セット内に "平面上" で作成された大量の点があり、
この点の名前のテキストをDrawで点の位置に配置したいのです。

先日のものはテキストを配置する位置を探しまくって作業効率が
悪かった・・・。

SelectElement4を利用し、新たなビューを作成した上でテキストを
作成します。

'vba Draw_PointName_ver0.0.1  using-'KCL0.0.12'  by Kantoku

Option Explicit

Sub CATMain()
    'ﾄﾞｷｭﾒﾝﾄのﾁｪｯｸ
    If Not CanExecute("DrawingDocument") Then Exit Sub
    
    '選択
    Dim msg As String
    msg = "平面上の点を含んだ、形状ｾｯﾄを選択してください /ESC-終了"
    
    Dim res As Variant
    res = SelectItem4_Part(msg, msg, Array("HybridBody"))
    If IsEmpty(res) Then Exit Sub
    
    Dim hBdy As HybridBody
    Set hBdy = res(0)
    
    Dim pt As part
    Set pt = res(1)
    
    Dim infos  As Collection
    Set infos = getPointInfos(hBdy.HybridShapes, pt)
    
    If infos.Count < 1 Then
        msg = "配置する要素がありません!"
        MsgBox msg
        Exit Sub
    End If
    
    'exec
    Call initTxts(hBdy.name, infos)

End Sub

Private Sub initTxts( _
    ByVal vName As String, _
    ByVal infos As Collection)
    
    Dim vw As DrawingView
    Set vw = initView(vName)

    Dim txts As DrawingTexts
    Set txts = vw.Texts

    Dim info As Collection
    For Each info In infos
        Call txts.Add(info(1), info(2), info(3))
    Next

End Sub

Private Function initView( _
    ByVal vName As String) As DrawingView

    Dim doc As DrawingDocument
    Set doc = CATIA.ActiveDocument
    
    Dim views As DrawingViews
    Set views = doc.Sheets.ActiveSheet.views
    
    Set initView = views.Add("From_" & vName)
    
End Function

'return:list(list(str,double,double))
Private Function getPointInfos( _
    ByVal hShas As HybridShapes, _
    ByVal pt As part) As Collection
    
    Dim prms As Parameters
    Set prms = pt.Parameters
    
    Dim lst As Collection
    Set lst = New Collection
    
    Dim itm As AnyObject
    Dim prmH As Parameter
    Dim prmV As Parameter
    Dim subLst As Parameters
    Dim info As Collection
    
    For Each itm In hShas
        If typename(itm) = "HybridShapePointTangent" Then
            Set subLst = prms.SubList(itm, False)
            Set prmH = GetParameter("H", subLst)
            Set prmV = GetParameter("V", subLst)
            
            Set info = New Collection
            With info
                .Add itm.name
                .Add prmH.Value
                .Add prmV.Value
            End With
            
            lst.Add info
        End If
    Next
    
    Set getPointInfos = lst
End Function

'ﾊﾟﾗﾒｰﾀ取得
Private Function GetParameter( _
    ByVal key As String, _
    ByVal params As Parameters) As Parameter
    
    Set GetParameter = Nothing
    
    Dim prm As Parameter
    Err.Number = 0
    On Error Resume Next
        Set prm = params.Item(key)
    On Error GoTo 0
    
    Set GetParameter = prm
End Function

'SelectElement4
'pram:filter-AryVariant(string)
'return:ary(anyobj,part)
Private Function SelectItem4_Part( _
    ByVal msg1 As String, _
    ByVal msg2 As String, _
    ByVal filter As Variant) As Variant
    
    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
    
    Dim ary(1)
    Set ary(0) = tgtSel.Item2(1).Value
    Set ary(1) = tgtSel.Parent.part
    
    SelectItem4_Part = ary
    
    sel.Clear
    tgtSel.Clear
End Function

Drawをアクティブにし、マクロ起動。
Partで点の入った形状セットを選択すると新たなビューを作成し、
点の位置に配置した点の名前のテキストを作成します。
出来上がるビューの名前は　"From_(選択した形状セット名)"　です。

劇的に楽になるはず・・・。