Draw内のTextをサイズ毎に色を付ける2

こちらの続きです。
Draw内のTextをサイズ毎に色を付ける - C#ATIA

リンク先のトピが削除されている。
とりあえずコードが残っていたので再投稿。

'catvba  by kantoku
'Sample that changes color with text size

Option Explicit

Private Const OTHERCOLOR = "0, 0, 0"
    
Sub CATMain()
    
    Dim txts As Collection
    Set txts = getShowTxts()
    If txts Is Nothing Then Exit Sub
    
    Dim colorMap As Variant
    colorMap = initColorMap()
    
    Dim sizeDic As Object
    Set sizeDic = groupBySize(txts)
    
    Call execChangeColor(sizeDic, colorMap)
    
    MsgBox "Done"
End Sub

Private Sub execChangeColor( _
    ByVal group As Object, _
    ByVal colorMap As Variant)
    
    Dim sel As selection
    Set sel = CATIA.ActiveDocument.selection
    
    Dim vis As VisPropertySet
    Set vis = sel.VisProperties
    
    CATIA.HSOSynchronized = False
    
    Dim key As Variant ' Long
    Dim rgbAry As Variant
    Dim rgbTxt As String
    Dim dt As DrawingText
    For Each key In group.keys

        If UBound(colorMap) > key Then
            'In colormap
            rgbTxt = colorMap(key)
        Else
            'other
            rgbTxt = OTHERCOLOR
        End If

        rgbAry = Split(rgbTxt, ",")
        
        sel.Clear
        For Each dt In group(key)
            sel.Add dt
        Next
        
        Call vis.SetRealColor( _
            CLng(rgbAry(0)), _
            CLng(rgbAry(1)), _
            CLng(rgbAry(2)), _
            1)

    Next
    
    sel.Clear
    
    CATIA.HSOSynchronized = True
    
End Sub

'return dic(txtsize,lst(drawtxt))
Private Function groupBySize( _
    ByVal txts As Collection) _
    As Object

    Dim dic As Object
    Set dic = initDic()
    
    Dim dt As DrawingText
    Dim prop As DrawingTextProperties
    Dim key As Long
    Dim lst As Collection
    
    For Each dt In txts
        Set prop = dt.TextProperties
        key = CLng(prop.FONTSIZE)
        
        If dic.Exists(key) Then
            Call dic(key).Add(dt)
        Else
            Set lst = New Collection
            lst.Add dt
            Call dic.Add(key, lst)
        End If
    Next
    
    Set groupBySize = dic
    
End Function

Private Function initDic() _
    As Object
    
    Set initDic = CreateObject("Scripting.Dictionary")
    
End Function

Private Function getShowTxts() _
    As Collection
    
    Set getShowTxts = Nothing
    
    Dim sel As selection
    Set sel = CATIA.ActiveDocument.selection
    
    CATIA.HSOSynchronized = False
    
    sel.Clear
    sel.Search "CATDrwSearch.DrwText,scr"

    CATIA.HSOSynchronized = True
    
    If sel.Count < 1 Then
        MsgBox "Text not found"
        Exit Function
    End If
    
    Dim lst As Collection
    Set lst = New Collection
    
    Dim i As Long
    For i = 1 To sel.Count
        lst.Add sel.Item2(i).value
    Next
    
    sel.Clear
    Set getShowTxts = lst
    
End Function

Private Function initColorMap() _
    As Variant 'array(str)
    
    initColorMap = Array( _
        "255, 255, 0", _
        "128, 0, 255", _
        "0, 0, 255", _
        "0, 128, 255", _
        "0, 255, 255", _
        "0, 255, 0", _
        "0, 128, 0", _
        "211, 178, 125", _
        "255, 128, 0", _
        "255, 0, 0", _
        "255, 0, 255", _
        "128, 64, 64")

End Function

閉鎖的だな。スタンスにがっかりした。
こんなのお金にはならないのに。