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

投稿日:2016/9/1 (木) 更新日:

'******************************************************************************
' 定義      :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

放物線を描く式

関連記事

-プログラミング, ArcGIS
-,

Copyright© WINGFIELD since1981 , 2018 All Rights Reserved.