公共測量、土木設計、用地境界測量、土木建築用測量、土地調査、各種申請etc...株式会社 滝下測量設計事務所(京都府綾部市、福知山市)

'縮尺係数の計算
Option Explicit
Const PI = 3.14159265358979
Const SEKAI = 0
Const NIHON = 1

Dim R() As Double
Dim f() As Double
Dim LAT() As Double
Const m0 = 0.9999
Dim InitFlg As Boolean

'Y座標、座標系(1〜19)、測地系(0=世界,1=日本)
Function Get縮尺係数(ByVal Y座標 As Double, _
                ByVal 座標系 As Integer, _
                ByVal 測地系 As Integer) As Double

    If InitFlg = False Then Call Init縮尺係数

    If (座標系 < 1) Or (19 < 座標系) Then MsgBox "座標系の指定が不正です": Exit Function
    If (測地系 < 0) Or (1 < 測地系) Then MsgBox "測地系の指定が不正です": Exit Function

    Dim e As Double
    e = (Sqr(2 * f(測地系) - 1)) / f(測地系)

    Dim SinΦ2 As Double
    SinΦ2 = Sin(DEG2RAD(LAT(座標系))) ^ 2

    Dim R0 As Double
    R0 = R(測地系) * (Sqr(1 - e ^ 2) / (1 - e ^ 2 * SinΦ2))

    Get縮尺係数 = m0 * (1 + ((3 * Y座標 ^ 2) / (6 * R0 ^ 2 * m0 ^ 2)))

End Function

'DEGREE→RADIAN
Function DEG2RAD(ByVal DEG As Double) As Double
    DEG2RAD = (PI / 180) * DEG
End Function


'初期化
Sub Init縮尺係数()

    InitFlg = True

    '長半径
    ReDim R(1)
    R(SEKAI) = 6378137#
    R(NIHON) = 6377397.155

    '扁平率
    ReDim f(1)
    f(SEKAI) = 298.257222101
    f(NIHON) = 299.152813

    '緯度
    ReDim LAT(1 To 19)
    LAT(1) = 33
    LAT(2) = 33
    LAT(3) = 33
    LAT(4) = 33
    LAT(5) = 36
    LAT(6) = 36
    LAT(7) = 36
    LAT(8) = 36
    LAT(9) = 36
    LAT(10) = 40
    LAT(11) = 44
    LAT(12) = 44
    LAT(13) = 44
    LAT(14) = 26
    LAT(15) = 26
    LAT(16) = 26
    LAT(17) = 26
    LAT(18) = 20
    LAT(19) = 26

End Sub