Last active
August 5, 2017 18:35
-
-
Save vonwenm/7b0bbfd0c2b90431ef52327967525484 to your computer and use it in GitHub Desktop.
Example 01 VBA Code
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Option Explicit | |
| Private pPlace As String | |
| Private pLat As Double | |
| Private pLon As Double | |
| Public Function init(sPlace As String, dLat As Double, dLon As Double) As cMVW | |
| pPlace = sPlace | |
| pLat = dLat | |
| pLon = dLon | |
| Set init = Me | |
| End Function | |
| Public Function newPlace(sPlace As String, distance As Double, heading As Double) As cMVW | |
| Dim p As cMVW | |
| Set p = New cMVW | |
| Set newPlace = p.init(sPlace, _ | |
| getLatFromDistance(pLat, distance, heading), _ | |
| getLonFromDistance(pLat, pLon, distance, heading)) | |
| End Function | |
| Public Property Get place() As String | |
| place = pPlace | |
| End Property | |
| Public Property Let place(p As String) | |
| pPlace = p | |
| End Property | |
| Public Property Get lat() As Double | |
| lat = pLat | |
| End Property | |
| Public Property Get lon() As Double | |
| lon = pLon | |
| End Property | |
| Private Function getLatFromDistance(mLat As Double, d As Double, heading As Double) As Double | |
| Dim lat As Double | |
| ' convert ro radians | |
| lat = toRadians(mLat) | |
| getLatFromDistance = _ | |
| fromRadians( _ | |
| Application.WorksheetFunction.Asin(Sin(lat) * _ | |
| Cos(d / earthRadius) + _ | |
| Cos(lat) * _ | |
| Sin(d / earthRadius) * _ | |
| Cos(heading))) | |
| End Function | |
| Private Function getLonFromDistance(mLat As Double, mLon As Double, d As Double, heading As Double) As Double | |
| Dim lat As Double, lon As Double, newLat As Double | |
| ' convert ro radians | |
| lat = toRadians(mLat) | |
| lon = toRadians(mLon) | |
| newLat = toRadians(getLatFromDistance(mLat, d, heading)) | |
| getLonFromDistance = _ | |
| fromRadians( _ | |
| (lon + Application.WorksheetFunction.Atan2(Cos(d / earthRadius) - _ | |
| Sin(lat) * _ | |
| Sin(newLat), _ | |
| Sin(heading) * _ | |
| Sin(d / earthRadius) * _ | |
| Cos(lat)))) | |
| End Function | |
| Private Function earthRadius() As Double | |
| ' earth radius in km. | |
| earthRadius = 6371 | |
| End Function | |
| Private Function toRadians(deg) | |
| toRadians = Application.WorksheetFunction.Pi / 180 * deg | |
| End Function | |
| Private Function fromRadians(rad) As Double | |
| 'convert radians to degress | |
| fromRadians = 180 / Application.WorksheetFunction.Pi * rad | |
| End Function |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Option Explicit | |
| Public Sub getPlace() | |
| ' calculate a spot some distance and some heading from another | |
| Dim origin As cMVW, newPlace As cMVW | |
| Set origin = New cMVW | |
| With origin.init("guildford", 51.236835, -0.590127) _ | |
| .newPlace("somewhere 10km north east of guildford", 10, 45) | |
| Debug.Print .place, .lat, .lon | |
| MsgBox "Test1: " & .place & " " & .lat & " " & .lon | |
| End With | |
| MsgBox "Test2: " & origin.place & " " & origin.lat & " " & origin.lon | |
| End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment