GraphicsPathの処理の方向に悩む3

こちらの続きです。
GraphicsPathの処理の方向に悩む2 - C#ATIA

3次ﾍﾞｼﾞｪの処理が、何となく出来上がったような感じです。
CATIA側の確認したい部分も有った為、C#側で処理した
"MS P明朝" ﾌｫﾝﾄで "木" の座標値を利用して、VBAでの
ｻﾝﾌﾟﾙを作成してみました。

実行する際は、Partﾌｧｲﾙをｱｸﾃｨﾌﾞにして下さい。
又、座標系が1個必要です。

'vba 'MS P明朝ﾌｫﾝﾄ"木" のｻﾝﾌﾟﾙﾃﾞｰﾀ
Option Explicit
Private PT As Part
Private HSF As HybridShapeFactory
Private HB As HybridBody
Private PassPnt() As ObjRef  '作業用通過点
Private Spline As ObjRef  '作業用ｽﾌﾟﾗｲﾝ
Private Const PassPntMax = 5

Type ObjRef
    Obj As AnyObject
    Ref As Reference
End Type

Sub CATMain()
    'ﾌｫﾝﾄﾃﾞｰﾀの取得
    Dim Font As Variant: Font = GetFontData(SampleData)

    '準備
    Set PT = CATIA.ActiveDocument.Part
    Set HSF = PT.HybridShapeFactory
    Set HB = PT.HybridBodies.Add
    
    'ﾀﾞﾐｰ点ｽﾌﾟﾗｲﾝ作成
    ReDim PassPnt(PassPntMax - 1)
    Dim i As Long
    For i = 0 To PassPntMax - 1
        PassPnt(i) = CreateDammyPoint(0, i * 1#)
    Next
    Spline = CreateDammySpline(PassPnt(0).Ref, PassPnt(PassPntMax - 1).Ref)

    'ﾗｲﾝ作成
    Dim LC As Long, PC As Long
    Dim SplineDatum As AnyObject
    
    For LC = 0 To UBound(Font) '線の数
        For PC = 0 To UBound(Font(LC)(1)) '通過点の数
            UpdatePoint PC, Font(LC)(1)(PC)(0), Font(LC)(1)(PC)(1) * -1# 'Yは逆
        Next
        UpdateSpline UBound(Font(LC)(1))
        HB.AppendHybridShape GetSplineDatum(Font(LC)(0)) '曲線ﾀｲﾌﾟ
    Next
    
    '終了
    MacroEnd
    PT.Update
End Sub

'終了
Private Sub MacroEnd()
    Dim i As Long
    With HSF
        .DeleteObjectForDatum Spline.Obj
        For i = 0 To PassPntMax - 1
            .DeleteObjectForDatum PassPnt(i).Obj
        Next
    End With
    Set PT = Nothing
    Set HSF = Nothing
    Set HB = Nothing
End Sub


'ｽﾌﾟﾗｲﾝﾃﾞｰﾀﾑ化
Private Function GetSplineDatum(ByVal CurveType As Long) As AnyObject
    Dim Dtm As AnyObject
    Select Case CurveType
        Case 1 '直線
            Set Dtm = HSF.AddNewLineDatum(Spline.Ref)
        Case 3 '曲線
            Set Dtm = HSF.AddNewCurveDatum(Spline.Ref)
    End Select
    PT.UpdateObject Dtm
    Set GetSplineDatum = Dtm
End Function

'ｽﾌﾟﾗｲﾝ更新
Private Sub UpdateSpline(ByVal AryCount As Long)
    Dim i As Long
    With Spline.Obj
        .RemoveAll
        For i = 0 To AryCount
            .AddPoint PassPnt(i).Ref
        Next
    End With
    PT.UpdateObject Spline.Obj
End Sub

'点更新
Private Sub UpdatePoint(ByVal PntIdx As Long, ByVal x As Double, ByVal y As Double)
    Dim Pnt3D As Variant: Pnt3D = Array(x, y, 0#)
    PassPnt(PntIdx).Obj.SetCoordinates Pnt3D
    PT.UpdateObject PassPnt(PntIdx).Obj
End Sub

'ﾀﾞﾐｰｽﾌﾟﾗｲﾝ
Private Function CreateDammySpline(ByRef SRef As Reference, ByRef ERef As Reference) As ObjRef
    Dim Spline As HybridShapeSpline: Set Spline = HSF.AddNewSpline()
    With Spline
        .SetSplineType 0 '1(WilsonFowler Type Spline)は何だろう?手動で作れない？
        .SetClosing 0
        .AddPoint SRef
        .AddPoint ERef
    End With
    PT.UpdateObject Spline
    CreateDammySpline = SetRef(Spline)
End Function

'ﾀﾞﾐｰ点
Private Function CreateDammyPoint(ByVal x As Double, ByVal y As Double) As ObjRef
    Dim Pnt As HybridShapePointCoord: Set Pnt = HSF.AddNewPointCoord(x, y, 0#)
    With PT
        Pnt.RefAxisSystem = _
            .CreateReferenceFromObject(.AxisSystems.Item(1))
        .UpdateObject Pnt
    End With
    CreateDammyPoint = SetRef(Pnt)
    HB.AppendHybridShape Pnt
End Function

'Reference取得
Private Function SetRef(ByRef Ao As AnyObject) As ObjRef
    Dim Re As ObjRef
    Set Re.Obj = Ao
    Set Re.Ref = PT.CreateReferenceFromObject(Ao)
    SetRef = Re
End Function

'ﾌｫﾝﾄﾃﾞｰﾀ取得 戻り-異様なｼﾞｬｸﾞ配列
Private Function GetFontData(ByRef FDs As Variant) As Variant
    Dim Bound(): ReDim Bound(UBound(FDs))
    Dim s, p, Pnts(1), XYs(), xy(1)
    Dim i As Long, j As Long
    For i = 0 To UBound(FDs)
        s = Split(FDs(i), "@")
        Pnts(0) = CLng(s(0))
        ReDim XYs(UBound(s) - 1)
        For j = 1 To UBound(s)
            p = Split(s(j), ",")
            xy(0) = CDbl(p(0)): xy(1) = CDbl(p(1))
            XYs(j - 1) = xy
        Next
        Pnts(1) = XYs
        Bound(i) = Pnts
    Next
    GetFontData = Bound
End Function

'ｻﾝﾌﾟﾙﾃﾞｰﾀ
Private Function SampleData() As Variant
    Dim FDCount As Long: FDCount = 20
    Dim FD() As String: ReDim FD(FDCount)
    FD(0) = "3@231.6621,147.9219@196.2888,195.8255@159.1371,236.8638@120.223,271.0288@79.5625,298.3125"
    FD(1) = "3@79.5625,298.3125@75.33276,297.0201@76.74268,292.8438"
    FD(2) = "3@76.74268,292.8438@119.9065,256.413@159.1691,215.3199@194.5384,169.5806@226.0225,119.2109"
    FD(3) = "1@226.0225,119.2109@86.56934,119.2109"
    FD(4) = "1@86.56934,119.2109@86.56934,111.0078"
    FD(5) = "1@86.56934,111.0078@231.6621,111.0078"
    FD(6) = "1@231.6621,111.0078@231.6621,28.97656"
    FD(7) = "1@231.6621,28.97656@255.5879,33.07813"
    FD(8) = "3@255.5879,33.07813@259.8176,38.95276@249.9482,42.64844"
    FD(9) = "1@249.9482,42.64844@249.9482,111.0078"
    FD(10) = "1@249.9482,111.0078@351.3765,111.0078"
    FD(11) = "1@351.3765,111.0078@372.4824,90.5"
    FD(12) = "1@372.4824,90.5@399.228,109.6406"
    FD(13) = "3@399.228,109.6406@403.4578,115.5153@399.228,119.2109"
    FD(14) = "1@399.228,119.2109@252.7681,119.2109"
    FD(15) = "3@252.7681,119.2109@286.156,169.5031@322.8685,209.5094@362.8974,239.2297@406.2349,258.6641"
    FD(16) = "3@406.2349,258.6641@389.3907,267.2517@378.1221,279.1719"
    FD(17) = "3@378.1221,279.1719@340.5511,251.8882@306.6652,217.7232@276.4642,176.6849@249.9482,128.7813"
    FD(18) = "1@249.9482,128.7813@249.9482,325.6563"
    FD(19) = "3@249.9482,325.6563@236.255,334.2225@231.6621,327.0234"
    FD(20) = "1@231.6621,327.0234@231.6621,147.9219"
    SampleData = FD
End Function

最初に実行した際、うっかりY座標の+-が逆なのを忘れてました・・・。
出来上がりはこちら

悪くないと思います。
まだ、色々と調べなきゃならないなぁ。