TL;DR
- 以下のサイトなどを参考（現在はリンク先消失）に作成した緯度経度から距離計算の方法
- また、緯度経度を表す様々な形式の相互変換を行う方法
- 今のところ北緯、東経だけしか考えていない（＋だけしか考えていない）
地球は丸い
地球は丸い。しかも完全な球体ではなく、楕円体となっている。
これで何が起こるかというと、距離計算は単純ではなくなる。
平面であれば、単純に2点間の距離を求めればよいが、実際に人間が感じる距離は、球面にそった経路の距離となる。
ゼンリン住宅地図などで使用されているのは、平面直角座標系となる。これは、地図を通常利用するならば2次元と考えるほうが人間が理解しやすく、狭い範囲であれば問題はないため、使われている。
平面直角座標系を使用した地図での距離であれば、座標単位もmであるため単純に2点間の距離を求めればよいのだが、緯度経度から距離を求めるということであれば、別の工夫が必要になってくる。
緯度経度から距離を計算する
緯度経度から距離を計算するには、球面を気にしないで計算してしまうか、球面を気にして細かい計算を行うか、ということになる。
BLCGetDistance
この関数では、地球を楕円体とみなしたうえで、2点間の距離を求めている。
ただし、2点間の直線距離であり、球面に沿った距離ではない。
距離が短いなら、これでもそれほど変わらないが、球面上の2点間の距離としては正確ではない
BLCDistTwoPoint
この関数では、地球を楕円体とみなすことに加え、2点間の距離を球面に沿って計算している。
地球には実際には凹凸があるが、その点を気にしなければ、かなり正確な距離が求められる。
緯度経度の表示形式
詳細はこちらに譲るが以下の形式がある。
| 表記 | 説明 | 例 |
|---|---|---|
| DMS形式(60進表記、度分秒を別で扱う) | 度分秒ミリ秒形式。それぞれを別で扱う | 131度27分22秒913ミリ秒 |
| DMS形式(60進表記、DDDMMSS.SSS)の文字列 | 度分秒ミリ秒形式を数値として扱う。小数点以下はミリ秒となる。 | 1312722.913 |
| DEG形式(10進表記、1を1度として表記する) | 1を1度として表記する。分と秒は度に換算して小数点以下の数値で表す。 | 131.456364722222 |
| ミリ秒形式（1を1ミリ秒としたInt32型） | 度・分・秒を1を1ミリ秒としたInt32に変換した表記 | 473242913 |
ソース
💡 BLCGetDistanceとBLCDistTwoPointで緯度経度の順番が不一致となっている（意図したものではないため訂正予定）。
modBLCalc.cls
#Disable Warning BC40000
Option Strict Off
Option Explicit On
Imports Microsoft.VisualBasic.Compatibility
Public Module modBLCalc
Private Const PI As Double = 3.14159265358979
''' <summary>
''' ２点間の距離
''' </summary>
''' <param name="lngLon1">経度 ミリ秒形式（1を1ミリ秒としたInt32型）</param>
''' <param name="lngLat1">緯度 ミリ秒形式（1を1ミリ秒としたInt32型）</param>
''' <param name="lngLon2">経度 ミリ秒形式（1を1ミリ秒としたInt32型）</param>
''' <param name="lngLat2">緯度 ミリ秒形式（1を1ミリ秒としたInt32型）</param>
''' <returns>直交座標に変換した後、距離を求める。狭い範囲の場合、これで十分</returns>
Public Function BLCGetDistance(ByVal lngLon1 As Integer,
ByVal lngLat1 As Integer,
ByVal lngLon2 As Integer,
ByVal lngLat2 As Integer) As Double
Dim X(1) As Double
Dim Y(1) As Double
Dim Z(1) As Double
Dim R As Double ' ２地点間の直交距離
Call BLCBL2SRC(lngLon1, lngLat1, X(0), Y(0), Z(0))
Call BLCBL2SRC(lngLon2, lngLat2, X(1), Y(1), Z(1))
' 直距離(m)
R = System.Math.Sqrt((X(1) - X(0)) ^ 2 + (Y(1) - Y(0)) ^ 2 + (Z(1) - Z(0)) ^ 2)
Return R
End Function
''' <summary>
''' SRCからBLへ
''' </summary>
''' <param name="dblX"></param>
''' <param name="dblY"></param>
''' <param name="dblZ"></param>
''' <param name="lngLon">経度 ミリ秒形式（1を1ミリ秒としたInt32型）</param>
''' <param name="lngLat">緯度 ミリ秒形式（1を1ミリ秒としたInt32型）</param>
Public Sub BLCSRC2BL(ByVal dblX As Double,
ByVal dblY As Double,
ByVal dblZ As Double,
ByRef lngLon As Integer,
ByRef lngLat As Integer)
Dim dblLon, dblLat As Double
Dim R As Double
Dim delta As Double
If dblX > 0 Then
delta = 0
ElseIf dblX < 0 And dblY > 0 Then
delta = PI
Else
delta = -PI
End If
' SRCからBLへ
dblLon = (System.Math.Atan(dblY / dblX) + delta) * 180 / PI
R = System.Math.Sqrt(dblX ^ 2 + dblY ^ 2 + dblZ ^ 2)
dblLat = (System.Math.Atan((dblZ / R) / System.Math.Sqrt(-(dblZ / R) ^ 2 + 1))) * 180 / PI
' BLの単位を変換(度→ミリ秒)
lngLon = dblLon * 60 * 60 * 1000
lngLat = dblLat * 60 * 60 * 1000
End Sub
''' <summary>
''' BLから地心直交座標(SRC:Space Rectangular Coordinates)へ
''' </summary>
''' <param name="lngLon">経度 ミリ秒形式（1を1ミリ秒としたInt32型）</param>
''' <param name="lngLat">緯度 ミリ秒形式（1を1ミリ秒としたInt32型）</param>
''' <param name="dblX"></param>
''' <param name="dblY"></param>
''' <param name="dblZ"></param>
Public Sub BLCBL2SRC(ByVal lngLon As Integer,
ByVal lngLat As Integer,
ByRef dblX As Double,
ByRef dblY As Double,
ByRef dblZ As Double)
Dim dblLon, dblLat As Double ' 緯度、経度(単位:度)
Dim N As Double
Const a As Double = 6377397.155 ' 赤道半径
Const E2 As Double = 0.006674372 ' 離心率の自乗
Const RAD As Double = 0.0174532925199433 ' ラジアン
' Const a = 6378136 ' 赤道半径
' Const E2 = 0.00669447 ' 離心率の自乗
' Const RAD = 1.74532925199433E-02 ' ラジアン
' BLの単位を変換(ミリ秒→度)
dblLon = lngLon / 60 / 60 / 1000
dblLat = lngLat / 60 / 60 / 1000
' BLからSRCへ
N = a / System.Math.Sqrt(1 - E2 * System.Math.Sin(dblLat * RAD) ^ 2)
dblX = N * System.Math.Cos(dblLon * RAD) * System.Math.Cos(dblLat * RAD)
dblY = N * System.Math.Sin(dblLon * RAD) * System.Math.Cos(dblLat * RAD)
dblZ = N * (1 - E2) * System.Math.Sin(dblLat * RAD)
End Sub
''' <summary>
''' 歪みも考慮に入れて2つの緯経度から距離を求める
''' </summary>
''' <param name="plngFromLatMS">出発点の緯度 ミリ秒形式（1を1ミリ秒としたInt32型）</param>
''' <param name="plngFromLonMS">出発点の経度 ミリ秒形式（1を1ミリ秒としたInt32型）</param>
''' <param name="plngToLatMS">到着点の緯度 ミリ秒形式（1を1ミリ秒としたInt32型）</param>
''' <param name="plngToLonMS">到着点の経度 ミリ秒形式（1を1ミリ秒としたInt32型）</param>
''' <param name="α1">出発点からみた到着点の角度（ラジアン）を返却</param>
''' <param name="α21">到着点から見た出発点の角度（ラジアン）</param>
''' <returns>距離 単位[m]</returns>
Public Function BLCDistTwoPoint(ByVal plngFromLatMS As Integer,
ByVal plngFromLonMS As Integer,
ByVal plngToLatMS As Integer,
ByVal plngToLonMS As Integer,
Optional ByRef α1 As Double = 0,
Optional ByRef α21 As Double = 0) As Double
Dim α2 As Double
Dim φ1 As Double
Dim L1 As Double
Dim φ2 As Double
Dim L2 As Double
Dim f As Double '扁平率
Dim a As Double '長半径
Dim L As Double
Dim Ld As Double
Dim Δ As Double
Dim Δd As Double
Dim Σ As Double
Dim Σd As Double
Dim ξ As Double
Dim ξd As Double
Dim η As Double
Dim ηd As Double
Dim X As Double
Dim Y As Double
Dim c As Double
Dim ε As Double
Dim u1 As Double
Dim u2 As Double
Dim θ As Double
Dim R As Double
Dim d1 As Double
Dim d2 As Double
Dim f1 As Double
Dim q As Double
Dim γ0 As Double
Dim A0 As Double
Dim B0 As Double
Dim ψ As Double
Dim j As Double
Dim j1 As Double
Dim k As Double
Dim ψd As Double
Dim ψdd As Double
Dim α As Double
Dim Γ As Double
Dim L_A As Double
Dim n0 As Double
Dim s As Double
Dim ζ As Double
Dim ζd As Double
Dim Δα As Double
Dim g As Double
Dim h As Double
Dim L_J As Double
Dim L_K As Double
Dim L_D As Double
Dim L_E As Double
Dim L_F As Double
Dim L_G As Double
Dim L_B As Double
Dim m As Double
Dim N As Double
Dim w As Double
Dim Tmp1 As Double
Dim Tmp2 As Double
Dim Tmp3 As Double
Dim ValBak As Double
Dim IsUseFirst As Boolean
Dim IsRepeat As Boolean
Dim IsCalced As Boolean
Dim IsReverse As Boolean
Const MARUME As Short = 20
'もし緯度経度が同じ場合には0を返却し終了する。
If (plngFromLatMS = plngToLatMS) And (plngFromLonMS = plngToLonMS) Then
Return 0
End If
'初期設定
f = 1.0# / 299.1528 '扁平率
a = 6377397.155 '長半径
'ラジアン
If plngFromLatMS > plngToLatMS Then
IsReverse = True
φ1 = BLCLongDegreeToRad(plngToLatMS)
L1 = BLCLongDegreeToRad(plngToLonMS)
φ2 = BLCLongDegreeToRad(plngFromLatMS)
L2 = BLCLongDegreeToRad(plngFromLonMS)
Else
φ1 = BLCLongDegreeToRad(plngFromLatMS)
L1 = BLCLongDegreeToRad(plngFromLonMS)
φ2 = BLCLongDegreeToRad(plngToLatMS)
L2 = BLCLongDegreeToRad(plngToLonMS)
End If
L = L2 - L1
Ld = AngleToRad(180.0#) - L
Δ = (-φ1 + φ2)
Σ = (φ1 + φ2)
'Σd = u1 + u2 = 下の式
Σd = System.Math.Atan(((1 - f) * System.Math.Sin(Σ)) / (System.Math.Cos(Σ) + f * (2 - f) * System.Math.Sin(φ1) * System.Math.Sin(φ2)))
'Δd = -u1 + u2 = 下の式
Δd = System.Math.Atan(((1 - f) * System.Math.Sin(Δ)) / (System.Math.Cos(Δ) - f * (2 - f) * System.Math.Sin(φ1) * System.Math.Sin(φ2)))
'上記の式からu1とu2を求める。
u1 = (Σd - Δd) / 2.0#
u2 = (Σd + Δd) / 2.0#
ξ = System.Math.Cos(Σd / 2.0#)
ξd = System.Math.Sin(Σd / 2.0#)
η = System.Math.Sin(Δd / 2.0#)
ηd = System.Math.Cos(Δd / 2.0#)
X = System.Math.Sin(u1) * System.Math.Sin(u2)
Y = System.Math.Cos(u1) * System.Math.Cos(u2)
c = (Y * System.Math.Cos(L)) + X
ε = (f * (2.0# - f)) / ((1.0# - f) ^ 2)
'θの初期値を求める
'(1) c >= 0の場合
If c >= 0# Then
IsRepeat = True
IsUseFirst = True
θ = L * (1.0# + (f * Y))
'(2) 0 > c >= -cos(3°cosu1) の場合
ElseIf (c < 0#) And (c >= (-1.0# * System.Math.Cos(3.0# * System.Math.Cos(u1)))) Then
IsRepeat = True
θ = Ld
'(3) c < -cos(3°cosu1) の場合
ElseIf (c < (-1 * System.Math.Cos(3 + System.Math.Cos(u1)))) Then
'※共通処理
R = f * PI * (System.Math.Cos(u1) ^ 2) * (1.0# - (1.0# / 4.0#) * f * (1.0# + f) * (System.Math.Sin(u1) ^ 2) + (3.0# / 16.0#) * (f ^ 2) * (System.Math.Sin(u1) ^ 4))
d1 = (Ld * System.Math.Cos(u1)) - R
d2 = System.Math.Abs(Σd) + R
q = Ld / (f * PI)
f1 = (1.0# / 4.0#) * f * (1.0# + (1.0# / 2.0#) * f)
γ0 = q + (f1 * q) - (f1 * (q ^ 3))
'(a)Σ<>0の場合θの初期値の計算
If Σ <> 0 Then
IsRepeat = True
A0 = System.Math.Atan(d1 / d2)
B0 = Arcsin(R / System.Math.Sqrt((d1 ^ 2) + (d2 ^ 2)))
ψ = A0 + B0
j = γ0 / System.Math.Cos(u1)
k = (1.0# + f1) * System.Math.Abs(Σd) * ((1.0# - f * Y) / (f * PI * Y))
j1 = j / (1.0# + k * Sec(ψ))
ψd = Arcsin(j1)
ψdd = Arcsin((System.Math.Cos(u1) / System.Math.Cos(u2)) * j1)
θ = 2.0# * System.Math.Atan((System.Math.Tan((ψd + ψdd) / 2.0#) * System.Math.Sin(System.Math.Abs(Σd) / 2.0#)) / System.Math.Cos(Δd / 2.0#))
'(b)Σ = 厳密に0の場合
Else
'(b1) d1 > 0 の場合
If d1 > 0# Then
IsRepeat = True
θ = Ld
'(b2) d1 = 0 の場合
ElseIf d1 = 0# Then
IsCalced = True
'角度と距離
α1 = AngleToRad(90.0#)
α2 = AngleToRad(90.0#)
α21 = AngleToRad(270.0#)
Γ = (System.Math.Sin(u1) ^ 2)
n0 = (ε * Γ) / ((System.Math.Sqrt(1.0# + ε * Γ) + 1.0#) ^ 2)
L_A = (1.0# + n0) * (1 + (5.0# / 4.0#) * (n0 ^ 2))
s = (1.0# - f) * a * L_A * PI
'(b3) d1 < 0 の場合
ElseIf d1 < 0 Then
IsCalced = True
Do
ValBak = Γ
Γ = q / (1.0# - L_D * Γ)
Γ = 1.0# - (Γ ^ 2)
L_D = ((1.0# / 4.0#) * f * (1 + f)) - ((3.0# / 16.0#) * (f ^ 2) * Γ)
If System.Math.Round(Γ, MARUME) = System.Math.Round(γ0, MARUME) Then
Exit Do
ElseIf ValBak = Γ Then
Exit Do
End If
Loop
m = 1 - q * Sec(u1)
N = (L_D * Γ) / (1 - L_D * Γ)
w = m - N + m * N
'角度と距離
If w <= 0# Then
α1 = AngleToRad(90.0#)
ElseIf w > 0 Then
α1 = AngleToRad(90.0#) - 2 * Arcsin(System.Math.Sqrt(w / 2.0#))
End If
α2 = AngleToRad(180.0#) - α1
α21 = AngleToRad(180.0#) * α2
L_A = (1.0# + n0) * (1 + (5.0# / 4.0#) * (n0 ^ 2))
s = (1 - f) * a * L_A * PI
End If
End If
End If
'値が求められていない場合は計算を行う
If Not (IsCalced) Then
If IsRepeat Then
Do
If IsUseFirst Then
g = System.Math.Sqrt(((η ^ 2) * (System.Math.Cos(θ / 2.0#) ^ 2)) + ((ξ ^ 2) * (System.Math.Sin(θ / 2.0#) ^ 2)))
Else
g = System.Math.Sqrt(((η ^ 2) * (System.Math.Sin(θ / 2.0#) ^ 2)) + ((ξ ^ 2) * (System.Math.Cos(θ / 2.0#) ^ 2)))
End If
If IsUseFirst Then
h = System.Math.Sqrt(((ηd ^ 2) * (System.Math.Cos(θ / 2.0#) ^ 2)) + ((ξd ^ 2) * (System.Math.Sin(θ / 2.0#) ^ 2)))
Else
h = System.Math.Sqrt(((ηd ^ 2) * (System.Math.Sin(θ / 2.0#) ^ 2)) + ((ξd ^ 2) * (System.Math.Cos(θ / 2.0#) ^ 2)))
End If
Σ = 2.0# * System.Math.Atan(g / h)
L_J = 2.0# * g * h
L_K = (h ^ 2) - (g ^ 2)
Γ = (Y * System.Math.Sin(θ)) / L_J
Γ = 1.0# - (Γ ^ 2)
ζ = Γ * L_K - 2 * X
ζd = ζ + X
L_D = (1.0# / 4.0#) * f * (1.0# + f) - (3.0# / 16.0#) * (f ^ 2) * Γ
Tmp1 = (2.0# * (ζ ^ 2) - (Γ ^ 2))
Tmp2 = (ζ + L_D * L_K * Tmp1)
Tmp3 = (Σ + L_D * L_J * Tmp2)
L_E = (1.0# - L_D * Γ) * (f * Γ) * Tmp3
' L_E = (1# - L_D * Γ) * (f * γ) * (σ + L_D * L_J * (ζ + L_D * L_K * (2# * (ζ ^ 2) - (Γ ^ 2))))
'値の保存
ValBak = L_F
If IsUseFirst Then
L_F = θ - L - L_E
Else
L_F = θ - Ld + L_E
End If
L_G = f * (Γ ^ 2) * (1.0# - 2.0# * L_D * Γ) + f * ζd * (Σ / L_J) * (1 - L_D * Γ + (1.0# / 2.0#) * f * (Γ ^ 2)) + (1.0# / 4.0#) * (f ^ 2) * ζ * ζd
θ -= ((L_F) / (1.0# - L_G))
If System.Math.Round(L_F, MARUME) = 0 Then
Exit Do
ElseIf ValBak = L_F Then
Exit Do
End If
'丸めている
Loop
End If
'■方位角の計算
If IsUseFirst Then
α = System.Math.Atan(ξ * System.Math.Tan(θ / 2.0#) / η)
Else
α = System.Math.Atan(ηd * System.Math.Tan(θ / 2.0#) / ξd)
End If
If IsUseFirst Then
Δα = System.Math.Atan((ξd * System.Math.Tan(θ / 2.0#)) / ηd)
Else
Δα = System.Math.Atan((η * System.Math.Tan(θ / 2.0#)) / ξ)
End If
α1 = α - (Δα / 2.0#)
If IsUseFirst Then
α2 = α + (Δα / 2.0#)
Else
α2 = AngleToRad(180.0#) - α - (Δα / 2.0#)
End If
α21 = AngleToRad(180.0#) + α2
'■測地長線の計算
n0 = (ε * Γ) / ((System.Math.Sqrt(1.0# + ε * Γ) + 1.0#) ^ 2)
L_A = (1.0# + n0) * (1 + (4.0# / 5.0#) * (n0 ^ 2))
L_B = (ε * (1.0# - (3.0# / 8.0#) * (n0 ^ 2))) / ((System.Math.Sqrt(1.0# + ε * Γ) + 1.0#) ^ 2)
Tmp1 = L_K * ((Γ ^ 2) - 2.0# * (ζ ^ 2)) - (1.0# / 6.0#) * L_B * ζ * (1.0# - 4.0# * (L_K ^ 2)) * (3.0# * (Γ ^ 2) - 4.0# * (ζ ^ 2))
Tmp2 = ζ - (1.0# / 4.0#) * L_B * Tmp1
Tmp3 = Σ - L_B * L_J * Tmp2
s = (1.0# - f) * a * L_A * Tmp3
' s = (1# - f) * a * L_A * ( _
'σ - L_B * L_J * ( _
'ζ - (1# / 4#) * L_B * ( _
'L_K * ((Γ ^ 2) - 2# * (ζ ^ 2)) - (1# / 6#) * L_B * ζ * (1# - 4# * (L_K ^ 2)) * (3# * (Γ ^ 2) - 4# * (ζ ^ 2)) _
') _
') _
')
End If
'値を返却
If IsReverse Then
Tmp1 = α1
α1 = α21
α21 = Tmp1
End If
Return s
End Function
''' <summary>
''' ラジアンを求める（ミリ秒形式（1を1ミリ秒としたInt32型）の緯度経度から）
''' </summary>
Public Function BLCLongDegreeToRad(ByVal plngDegree As Integer) As Double
Return ((plngDegree / 3600000.0#) * (PI / 180.0#))
End Function
Private Function Sec(ByVal pX As Double) As Double
Return 1 / System.Math.Cos(pX)
End Function
Private Function Arcsin(ByVal pX As Double) As Double
Return System.Math.Atan(pX / System.Math.Sqrt(-pX * pX + 1))
End Function
''' <summary>
''' ラジアンを求める（角度から）
''' </summary>
Private Function AngleToRad(ByVal pdblAngle As Double) As Double
Return (pdblAngle * (PI / 180.0#))
End Function
''' <summary>
''' ミリ秒形式（1を1ミリ秒としたInt32型）をDMS形式(60進表記、度分秒を別で扱う)に変換する
''' </summary>
Public Sub BLCLongMSToDMSmSec(ByVal plngMS As Integer,
ByRef plngRetD As Integer,
ByRef plngRetM As Integer,
ByRef plngRetS As Integer,
ByRef pdblRetmsec As Double)
plngRetD = CInt(plngMS \ CInt(3600000)) ' 度
plngRetM = CInt((plngMS \ CInt(60000)) Mod CInt(60)) ' 分
plngRetS = CInt((plngMS \ CInt(1000)) Mod CInt(60)) ' 秒
pdblRetmsec = CDbl(plngMS) Mod CDbl(1000) ' ミリ秒
End Sub
''' <summary>
''' DMS形式(60進表記、度分秒を別で扱う)をミリ秒形式（1を1ミリ秒としたInt32型）に変換する
''' </summary>
Public Function BLCDMSmSecToLongMS(ByVal plngD As Integer,
ByVal plngM As Integer,
ByVal plngS As Integer,
ByVal pdblmSec As Double) As Integer
Return (plngD * CInt(3600000)) + (plngM * CInt(60000)) + (plngS * CInt(1000)) + CInt(pdblmSec)
End Function
''' <summary>
''' Double型ミリ秒（60分法）をDMS形式(60進表記、度分秒を別で扱う)に変換する
''' </summary>
Public Sub BLCDoubleMSToDMSmSec(ByVal pdblMS As Double,
ByRef plngRetD As Integer,
ByRef plngRetM As Integer,
ByRef plngRetS As Integer,
ByRef pdblRetmsec As Double)
plngRetD = Int(pdblMS)
plngRetM = Int((pdblMS - CDbl(plngRetD)) * CDbl(60))
plngRetS = Int((pdblMS - (CDbl(plngRetD) + (CDbl(plngRetM) / CDbl(60)))) * CDbl(3600))
pdblRetmsec = (pdblMS - (CDbl(plngRetD) + (CDbl(plngRetM) / CDbl(60)) + (CDbl(plngRetS) / CDbl(3600)))) * CDbl(3600000)
End Sub
''' <summary>
''' DMS形式(60進表記、度分秒を別で扱う)をDEG形式(10進表記、1を1度として表記する)に変換する
''' </summary>
Public Function BLCDMSmSecToDoubleMS(ByVal plngD As Integer,
ByVal plngM As Integer,
ByVal plngS As Integer,
ByVal pdblmSec As Double) As Double
Return CDbl(plngD) + CDbl(plngM) / CDbl(60) + CDbl(plngS) / CDbl(3600) + pdblmSec / CDbl(3600000)
End Function
''' <summary>
''' DEG形式(10進表記、1度を1とした十進法)をミリ秒形式（1を1ミリ秒としたInt32型）に変換する
''' </summary>
Public Function BLCDoubleMSToLongMS(ByVal pdblMS As Double) As Integer
Dim lngD As Integer
Dim lngM As Integer
Dim lngS As Integer
Dim dblMSec As Double
Call BLCDoubleMSToDMSmSec(pdblMS, lngD, lngM, lngS, dblMSec)
Return BLCDMSmSecToLongMS(lngD, lngM, lngS, dblMSec)
End Function
''' <summary>
''' ミリ秒形式（1を1ミリ秒としたInt32型）をDEG形式(10進表記、1度を1とした十進法)に変換する
''' </summary>
Public Function BLCLongMSToDoubleMS(ByVal plngMS As Integer) As Double
Dim lngD As Integer
Dim lngM As Integer
Dim lngS As Integer
Dim dblMSec As Double
Call BLCLongMSToDMSmSec(plngMS, lngD, lngM, lngS, dblMSec)
Return BLCDMSmSecToDoubleMS(lngD, lngM, lngS, dblMSec)
End Function
''' <summary>
''' DMS形式(60進表記、DDDMMSS.SSS)の文字列をDEG形式(10進表記、1度を1とした十進法)に変換する
''' </summary>
Public Function BLCDDDMMSS_sssToDoubleMS(ByVal insDDDMMSSsss As String) As Double
Dim dblMM As Double
Dim dblDD As Double
Dim dblSS As Double
Dim dblMSec As Double
If Not IsNumeric(insDDDMMSSsss) Then
Return 0
End If
'-- 度
dblDD = CDbl(CDbl(insDDDMMSSsss) \ CInt(10000))
'-- 分
dblMM = CInt(CDbl(insDDDMMSSsss) \ CInt(100)) - (CInt(CDbl(insDDDMMSSsss) \ CInt(10000)) * CInt(100))
dblMM /= (CDbl(60) ^ 1)
'-- 秒
dblSS = CInt(CDbl(insDDDMMSSsss) \ CInt(1)) - (CInt(CDbl(insDDDMMSSsss) \ CInt(100)) * CInt(100))
dblSS /= (CDbl(60) ^ 2)
'-- ミリ秒
dblMSec = (CDbl(insDDDMMSSsss) - CDbl(CDbl(insDDDMMSSsss) \ CInt(1))) / (CDbl(60) ^ 2)
Return dblDD + dblMM + dblSS + dblMSec
End Function
''' <summary>
''' DMS形式(60進表記、DDDMMSS.SSS)の文字列をミリ秒形式（1を1ミリ秒としたInt32型）に変換する関数
''' </summary>
Public Function BLCDDDMMSS_sssToLongMS(ByVal insDDDMMSSsss As Double) As Integer
Dim lngD As Integer
Dim lngM As Integer
Dim lngS As Integer
Dim dblMSec As Double
Dim lngMSec As Integer
If Not IsNumeric(insDDDMMSSsss) Then
Return 0
End If
'-- 度
lngD = CDbl(insDDDMMSSsss) \ CInt(10000)
lngD = lngD * (CInt(60) ^ 2) * CInt(1000)
'-- 分
lngM = CInt(CDbl(insDDDMMSSsss) \ CInt(100)) - (CInt(CDbl(insDDDMMSSsss) \ CInt(10000)) * CInt(100))
lngM = lngM * (CInt(60) ^ 1) * CInt(1000)
'-- 秒
lngS = CInt(CDbl(insDDDMMSSsss) \ CInt(1)) - (CInt(CDbl(insDDDMMSSsss) \ CInt(100)) * CInt(100))
lngS *= CInt(1000)
'-- ミリ秒
dblMSec = CDbl(insDDDMMSSsss) - CDbl(CDbl(insDDDMMSSsss) \ CInt(1))
lngMSec = CInt(Int(dblMSec * CDbl(1000)))
Return lngD + lngM + lngS + lngMSec
End Function
''' <summary>
''' DEG形式(10進表記、1を1度として表記する)を、DMS形式(60進表記、DDDMMSS.SSS)の文字列に変換する関数
''' </summary>
''' <returns>小数点4桁以降もとりあえず返す</returns>
Public Function BLCDoubleMSToDDDMMSS_sss(ByVal indDoubleMS As String) As String
Dim lngD As Integer
Dim lngM As Integer
Dim lngS As Integer
Dim dblMSec As Double
Dim strmSec As String
Dim strSeisu As String
Dim strShousu As String
Call BLCDoubleMSToDMSmSec(CDbl(indDoubleMS), lngD, lngM, lngS, dblMSec)
'' 十進数型に変換する
strmSec = CStr(CDec(CDbl(dblMSec)))
If InStr(1, strmSec, ".") > 0 Then
strSeisu = Mid(strmSec, 1, InStr(1, strmSec, ".") - 1)
strShousu = Mid(strmSec, InStr(1, strmSec, ".") + 1)
Else
strSeisu = strmSec
strShousu = "0"
End If
strSeisu = VB6.Format(strSeisu, "000")
Return CStr(lngD) & VB6.Format(lngM, "00") & VB6.Format(lngS, "00") & "." & strSeisu & strShousu
End Function
''' <summary>
''' ミリ秒形式（1を1ミリ秒としたInt32型）をDMS形式(60進表記、DDDMMSS.SSS)の文字列に変換する関数
''' </summary>
''' <param name="inlLongMS"></param>
''' <returns>小数点3桁まで返す</returns>
Public Function BLCLongMSToDDDMMSS_sss(ByVal inlLongMS As Double) As String
Dim lngD As Integer
Dim lngM As Integer
Dim lngS As Integer
Dim dblMSec As Double
Dim strmSec As String
Dim strSeisu As String
Call BLCLongMSToDMSmSec(inlLongMS, lngD, lngM, lngS, dblMSec)
'' 十進数型に変換する
strmSec = CStr(CDec(CDbl(dblMSec)))
If InStr(1, strmSec, ".") > 0 Then
strSeisu = Mid(strmSec, 1, InStr(1, strmSec, ".") - 1)
Else
strSeisu = strmSec
End If
strSeisu = VB6.Format(strSeisu, "000")
Return CStr(lngD) & VB6.Format(lngM, "00") & VB6.Format(lngS, "00") & "." & strSeisu
End Function
End Module