Tuesday, October 16, 2007

Function Microsoft Excel untuk Konversi Koordinat dari DMS ke Degree & Degree ke DMS

Format Data untuk Koordinat DMS dengan contoh :
116 50'19.4"E
01 16'41.0"S

Function di Microsoft Excel sebagai berikut :

Function Long_dec2dms(dec)
If dec < 0 Then
dec_h = "W"
Else
dec_h = "E"
End If

dec_deg = Int(dec)
dec_min = Int((dec - Int(dec)) * 60)
dec_sec = Int((dec - dec_deg - dec_min / 60) * 3600)
dec_msec = Round((dec - dec_deg - dec_min / 60 - dec_sec / 3600) * 3600 * 10, 0)
If Len(dec_deg) = 2 Then
dec_deg = "0" + Left(dec_deg, 2)
ElseIf Len(dec_deg) = 1 Then
dec_deg = "00" + Left(dec_deg, 1)
End If
If Len(dec_min) = 1 Then
dec_min = "0" + Left(dec_min, 1)
End If
If Len(dec_sec) = 1 Then
dec_sec = "0" + Left(dec_sec, 1)
End If

Long_dec2dms = Int(Left(dec_deg, 3) + " " + Left(dec_min, 2) + "'" + Left(dec_sec, 2) + "." + Left(dec_msec, 1) + """" + dec_h)

End Function

Function Lat_dec2dms(dec)
If dec < 0 Then
dec_h = "S"
dec = dec * -1
Else
dec_h = "N"
End If

dec_deg = Int(dec)
dec_min = Int((dec - Int(dec)) * 60)
dec_sec = Int((dec - dec_deg - dec_min / 60) * 3600)
dec_msec = Round((dec - dec_deg - dec_min / 60 - dec_sec / 3600) * 3600 * 10, 0)

If Len(dec_deg) = 1 Then
dec_deg = "0" + Left(dec_deg, 1)
End If
If Len(dec_min) = 1 Then
dec_min = "0" + Left(dec_min, 1)
End If
If Len(dec_sec) = 1 Then
dec_sec = "0" + Left(dec_sec, 1)
End If

Lat_dec2dms = Int(Left(dec_deg, 2) + " " + Left(dec_min, 2) + "'" + Left(dec_sec, 2) + "." + Left(dec_msec, 1) + """" + dec_h)

End Function

Function Sector_Lat(Lat_dec, orientation)

If Lat_dec < 0 Then
Sector_Lat = -1 * ((Lat_dec * -1) + ((18 / 3600) * Sin(((90 - orientation)) * Pi / 180)))
Else
Sector_Lat = ((Lat_dec) + ((18 / 3600) * Sin(((90 - orientation)) * Pi / 180)))
End If

End Function

Function Sector_Long(Long_dec, orientation)

If Long_dec < 0 Then
Sector_Long = -1 * ((Long_dec * -1) + ((18 / 3600) * Cos(((90 - orientation)) * Pi / 180)))
Else
Sector_Long = ((Long_dec) + ((18 / 3600) * Cos(((90 - orientation)) * Pi / 180)))
End If

End Function

No comments: