[XLS-MAP-02]: Rumus Proyeksi Traverse Mercator dengan VBA Excel (Macro)

Referensi	:	Dulu saya ambil dari sini tapi sekarang kok sdh nggak ada.
Platform	:	Excel
Lokasi File	:	ada di sini

Saat pertama kali menulis program ini pada 21 April 2006, tujuannya adalah membuat UDF (User Defined Function) di excel untuk memproyeksi koordinat Lintang Bujur ke North, East dan sebaliknya dari beberapa macam datum dan type sistem proyeksi.

Sampai saat ini baru sampai pada sistem proyeksi traverse mercator, mungkin dari rekan2 sekalian ingin mengembangkan lebih lanjut silahkan.

Pada file excel terlampir dalam project VBA terdapat satu module “mdlProjection” dan satu class “clsTranverseMercator”.

mdlProjection berisi fungsi untuk mendefinisikan parameter transformasi seperti :

Dim FalseEasting As Double, FalseNorthing As Double
Dim k0 As Double, a_ellips As Double, inv_f As Double
Dim LebarZone As Double

Sedangkan clsTranverseMercator berisi fungsi-fungsi proyeksi koordinat dalam Metode TraverseMercator dengang input atau masukan parameter dari module “mslProjectin”

Kode yang ada di “clsTransverseMercator”:

Option Explicit
Function GetCentralMeridian(Bujur As Double, ByVal WidthZone As Double) As Double
GetCentralMeridian = WidthZone * (Int(Bujur / WidthZone) + 0.5)
End Function

Function DegreeToRadian(AngleDegree As Double) As Double
Dim Phi As Double
Phi = 4 * Atn(1)
DegreeToRadian = AngleDegree * Phi / 180
End Function
Function RadianToDegree(AngleRadian As Double) As Double
Dim Phi As Double
Phi = 4 * Atn(1)
RadianToDegree = AngleRadian * 180 / Phi
End Function

Sengaja dalam fungsi konversi degree ke radian atau sebaliknya tidak menggunakan fungsi bawaan excel =DEGREES() atau =RADIANS() karena apabila program ini dipakai atau dicopy ke visual basic yang bukan excel masih bisa berfungsi.

Fungsi untuk memproyeksi Lintang Bujur ke North, East

Sub TransverseMercator( _
CentralMeridian As Double, LATITUDE As Double, LONGITUDE As Double, _
ScaleFactor As Double, a_ellips As Double, inv_f As Double, _
FalseEast As Double, FalseNorth As Double, _
North As Double, East As Double)

Dim Lr As Double, Lg As Double ‘Lr:Latitude in radian,Lg:Longitude in Radian
Dim dB As Double ‘dB:central meridian in radian
Lr = DegreeToRadian(LATITUDE)
Lg = DegreeToRadian(LONGITUDE)
dB = DegreeToRadian(CentralMeridian)
Dim f As Double, e2 As Double, e4 As Double, e6 As Double
Dim e_2 As Double
f = 1 / inv_f
e2 = 2 * f – f ^ 2: e4 = e2 * e2: e6 = e4 * e2
e_2 = e2 / (1 – e2)

Dim T As Double, C As Double, A As Double, M As Double
Dim T2 As Double, C2 As Double, v As Double
T = Tan(Lr) * Tan(Lr)
T2 = T * T
C = e_2 * Cos(Lr) * Cos(Lr)
C2 = C * C
A = (Lg – dB) * Cos(Lr)

Dim MA As Double, MB As Double, MC As Double, MD As Double
MA = (1 – (e2 / 4) – (3 * e4 / 64) – (5 * e6 / 256)) * Lr
MB = ((3 * e2 / 8) + (3 * e4 / 32) + (45 * e6 / 1024)) * Sin(2 * Lr)
MC = ((15 * e4 / 256) + (45 * e6 / 1024)) * Sin(4 * Lr)
MD = (35 * e6 / 3072) * Sin(6 * Lr)
M = a_ellips * (MA – MB + MC – MD)
v = a_ellips / Sqr(1 – e2 * Sin(Lr) * Sin(Lr))

Dim A2 As Double, A3 As Double, A4 As Double, A5 As Double, A6 As Double
Dim X As Double, Y As Double
Dim X1 As Double, X2 As Double
Dim Y1 As Double, Y2 As Double
A2 = A * A
A3 = A2 * A
A4 = A3 * A
A5 = A4 * A
A6 = A5 * A
X1 = (1 – T + C) * A3 / 6
X2 = (5 – 18 * T + T2 + 72 * C – 58 * e_2) * A5 / 120
X = ScaleFactor * v * (A + X1 + X2)
Y1 = (5 – T + 9 * C + 4 * C2) * A4 / 24
Y2 = (61 – 58 * T + T2 + 600 * C – 330 * e_2) * A6 / 720

Y = ScaleFactor * (M + v * Tan(Lr) * (A2 / 2 + Y1 + Y2))

North = FalseNorth + Y
East = FalseEast + X
End Sub

Fungsi untuk memproyeksikan North, East ke Lintang, Bujur adalah:

Sub InversTransverseMercator(CentralMeridian As Double, LATITUDE As Double, LONGITUDE As Double, _
ScaleFactor As Double, a_ellips As Double, inv_f As Double, _
FalseEast As Double, FalseNorth As Double, _
North As Double, East As Double)
Dim f As Double, e2 As Double, e4 As Double, e6 As Double
f = 1 / inv_f
e2 = 2 * f – f ^ 2
e4 = e2 * e2
e6 = e4 * e2
Dim M1 As Double, MiuA As Double, Miu As Double
M1 = (North – FalseNorth) / ScaleFactor
MiuA = 1 – e2 / 4 – (3 * e4) / 64 – (5 * e6) / 256
Miu = M1 / (a_ellips * MiuA)
Dim e_ As Double, e_2 As Double, e_3 As Double, e_4 As Double
e_ = (1 – Sqr(1 – e2)) / (1 + Sqr(1 – e2))
e_2 = e_ * e_
e_3 = e_2 * e_
e_4 = e_3 * e_
Dim Lf As Double, LfA As Double, LfB As Double, LfC As Double, LfD As Double
LfA = ((3 * e_ / 2) – (27 * e_3 / 32)) * Sin(2 * Miu)
LfB = ((21 * e_2 / 16) – (55 * e_4 / 32)) * Sin(4 * Miu)
LfC = ((151 * e_3 / 96)) * Sin(6 * Miu)
LfD = ((1097 * e_4 / 512)) * Sin(8 * Miu)
Lf = Miu + LfA + LfB + LfC + LfD

Dim v_ As Double, p_ As Double
v_ = a_ellips / Sqr(1 – e2 * Sin(Lf) * Sin(Lf))
p_ = a_ellips * (1 – e2) / ((1 – e2 * Sin(Lf) * Sin(Lf)) ^ 1.5)
Dim T_ As Double, C_ As Double, D As Double, e_a2 As Double, T_2 As Double
T_ = Tan(Lf) * Tan(Lf)
e_a2 = e2 / (1 – e2)
C_ = e_a2 * Cos(Lf) * Cos(Lf)
D = (East – FalseEast) / (v_ * ScaleFactor)
T_2 = T_ * T_

Dim D2 As Double, D3 As Double, D4 As Double, D5 As Double, D6 As Double
D2 = D * D
D3 = D2 * D
D4 = D3 * D
D5 = D4 * D
D6 = D5 * D
Dim C_2 As Double
C_2 = C_ * C_
Dim LatitudeA As Double, LatitudeB As Double, LatitudeC As Double
LatitudeA = D2 / 2
LatitudeB = (5 + 3 * T_ + 10 * C_ – 4 * C_2 – 9 * e_a2) * D4 / 24
LatitudeC = (61 + 90 * T_ + 298 * C_ + 45 * T_2 – 252 * e_a2 – 3 * C_2) * D6 / 720
Dim Lr As Double
Lr = Lf – v_ * Tan(Lf) * (LatitudeA – LatitudeB + LatitudeC) / p_
LATITUDE = RadianToDegree(Lr)
Dim LongA As Double, LongB As Double, Lg As Double, dB As Double
LongA = (1 + 2 * T_ + C_) * D3 / 6
LongB = (5 – 2 * C_ + 28 * T_ – 3 * C_2 + 8 * e_a2 + 24 * T_2) * D5 / 120

dB = DegreeToRadian(CentralMeridian)
Lg = dB + (D – LongA + LongB) / Cos(Lf)

LONGITUDE = RadianToDegree(Lg)

End Sub

Contoh penggunaan kedua fungsi tersebut, silahkan buka file terlampir

“semoga bermanfaat”

coretan tentang autocad dan excel

[XLS-MAP-02]: Rumus Proyeksi Traverse Mercator dengan VBA Excel (Macro)

One thought on “[XLS-MAP-02]: Rumus Proyeksi Traverse Mercator dengan VBA Excel (Macro)”

Leave a Reply Cancel reply

Share this:

Like this:

One thought on “[XLS-MAP-02]: Rumus Proyeksi Traverse Mercator dengan VBA Excel (Macro)”

Leave a Reply Cancel reply