曲線と戦ってみる8

こちらの続きです。
曲線と戦ってみる7 - C#ATIA

検証用の曲線を作成するのが面倒になってきたので、
ﾕﾆｰｸな曲線を作成するだけのﾏｸﾛを作りました。

'vba Partﾌｧｲﾙにランダムな曲線を作成
Option Explicit
Private Const CurveCountMin = 5&        '曲線最小数
Private Const CurveCountMax = 20&       '曲線最大数
Private Const PointValueMin = -1000#    '最小座標値
Private Const PointValueMax = 1000#     '最大座標値

Sub CATMain()
    Dim Doc As PartDocument: Set Doc = CATIA.ActiveDocument
    Dim Pt As Part: Set Pt = Doc.Part
    
    Dim CurveCount&: CurveCount = Int(GetRnd(CurveCountMin, CurveCountMax)) - 1
    Dim Curves() As AnyObject: ReDim Curves(CurveCount)
    Dim i&, j&, PntCount#, Poss() As Variant, PntRefs As Variant
    For i = 0 To CurveCount
        '通過点
        PntCount = Int(GetRnd(3, 10)) - 1
        ReDim Poss(PntCount)
        For j = 0 To PntCount
            Poss(j) = GetRndAry(PointValueMin, PointValueMax)
        Next
        PntRefs = InitPntRefs(Pt, Poss)
        '曲線
        Set Curves(i) = InitCurveDatum(Pt, PntRefs)
    Next
    
    '形状ｾｯﾄに登録
    Dim HB As HybridBody: Set HB = Doc.Part.HybridBodies.Add
    For i = 0 To CurveCount
        Call HB.AppendHybridShape(Curves(i))
    Next
    MsgBox "End"
End Sub

Private Function InitCurveDatum(ByVal Pt As Part, ByVal Refs As Variant) As HybridShapeCurveExplicit
    Dim Fact As HybridShapeFactory: Set Fact = Pt.HybridShapeFactory
    Dim Spline As HybridShapeSpline: Set Spline = Fact.AddNewSpline()
    Dim i&
    With Spline
        .SetSplineType 0
        .SetClosing 0
        For i = 0 To UBound(Refs)
            Call .AddPointWithConstraintExplicit(Refs(i), Nothing, -1#, 1, Nothing, 0#)
        Next
    End With
    Call Pt.UpdateObject(Spline)
    Dim SplineRef As Reference: Set SplineRef = Pt.CreateReferenceFromObject(Spline)
    Set InitCurveDatum = Fact.AddNewCurveDatum(SplineRef)
    Call Pt.UpdateObject(InitCurveDatum)
    Call Fact.DeleteObjectForDatum(SplineRef)
End Function

Private Function InitPntRefs(ByVal Pt As Part, ByVal Ary As Variant) As Variant
    Dim PntRefs() As Variant: ReDim PntRefs(UBound(Ary))
    Dim i&
    For i = 0 To UBound(Ary)
        Set PntRefs(i) = InitPntRef(Pt, Ary(i))
    Next
    InitPntRefs = PntRefs
End Function

Private Function InitPntRef(ByVal Pt As Part, ByVal Ary As Variant) As Reference
    Dim Fact As HybridShapeFactory: Set Fact = Pt.HybridShapeFactory
    Dim Pnt As HybridShapePointCoord: Set Pnt = Fact.AddNewPointCoord(Ary(0), Ary(1), Ary(2))
    Call Pt.UpdateObject(Pnt)
    Set InitPntRef = Pt.CreateReferenceFromObject(Pnt)
End Function

Private Function GetRndAry(ByVal Max#, ByVal Min#, Optional ByVal Count& = 3) As Variant
    Dim IdxMax&: IdxMax = Count - 1
    Dim Ary() As Double: ReDim Ary(IdxMax)
    Dim i&
    For i = 0 To IdxMax
        Ary(i) = GetRnd#(Max, Min)
    Next
    GetRndAry = Ary
End Function

Private Function GetRnd#(ByVal Max#, ByVal Min#)
    GetRnd = (Max - Min + 1) * Rnd + Min
End Function

他人に役立つとは思えない・・・。