ポリラインに放物線を描く Z 値を格納

'******************************************************************************
' 定義      :Public Function ProjectParabolaZ()
' 概要      :ポリラインに放物線を描くZ値を格納
' 第1引数   :IPointCollection   Z値を持つPolyline
' 第2引数   :Double             Z値の最大値(頂点のY座標)
' 戻り値    :Boolean            処理成功フラグ
'******************************************************************************
Public Function ProjectParabolaZAsRatio(ByRef PointCollection As IPointCollection, MaxHeight As Double) As Boolean
On Error GoTo Error:
    Dim pPointCollection As IPointCollection
    Set pPointCollection = PointCollection
    
    Dim pZAware As IZAware
    Set pZAware = pPointCollection
    
    'Z値の使用が許可されていない場合は返す
    If pZAware.ZAware = False Then
        ProjectParabolaZAsRatio = False
        Exit Function
    End If
    
    'M値の割り当てを一時的に許可
    Dim pMAware As IMAware
    Set pMAware = pPointCollection
    pMAware.MAware = True
    
    Dim pMSegmentation As IMSegmentation3
    Set pMSegmentation = pPointCollection
    pMSegmentation.SetMsAsDistance True     'ジオメトリのM値に距離比を割り当て
    
    Dim i As Long
    Dim pPoint As IPoint
    For i = 0 To pPointCollection.PointCount - 1
        Set pPoint = pPointCollection.Point(i)
        
        pPoint.Z = CalculateParabolaY(pPoint.M, MaxHeight)
        
        pPointCollection.UpdatePoint i, pPoint
        
    Next i
    
    Set Points = pPointCollection
    
    ProjectParabolaZAsRatio = True
    
Error:
    Debug.Print Err.Description, Err.LastDllError
    ProjectParabolaZAsRatio = False

End Function


'******************************************************************************
' 定義      :Public Function CalculateParabolaY()
' 概要      :飛翔経路の放物線を描く関数
' 第1引数   :Double     2次関数のX値
' 第2引数   :Double     2次関数の頂点のY座標
' 第3引数   :Double     X切片の片方の値(デフォルトでは0と1)
' 戻り値    :Double     2次関数のY座標
'******************************************************************************
Private Function CalculateParabolaY(X As Double, YTop As Double, Optional XMax As Double = 1) As Double
    '放物線を描くための二次方程式
    'Y = c(X - a)^2 + b
    '   a = 頂点のX座標
    '   b = 頂点のY座標
    '   c = 放物曲線の係数
    'X切片の片方が必ず(0,0)を通る場合、係数(c)は-b/a^2となる。地上から飛翔して地上に戻る放物曲線を描く(上に凸の放物線)ので係数は負となる
    
    '頂点のX座標(a)
    Dim XTop As Double  '2次関数の頂点のX座標
    XTop = XMax / 2
    
    '頂点のY座標(b)
'    YTop
    
    '放物曲線の係数(c)
    Dim theFactor As Double
    theFactor = -(YTop / XTop ^ 2)
    
    '二次方程式
    CalculateParabolaY = theFactor * (X - XTop) ^ 2 + YTop

End Function