Mission: Identify the coordinates of a center point using multiple pairs of Latitude & Longitude each with its own radius value. The number of pairs varies from 3 to 9. The pairs represent distances from an unknown (data not available) point. I’m trying to approximate, as accurately as possible, the latitude and longitude of the unknown point. Sometimes the circles overlap significantly and some circles barely touch or not at all.
Averaging Latitude and longitude points does not produce the desired point, nor does creating “weighted” averages of the longitude and longitude, using the radius as the factor (illustrated in the illustration code).
The below code example illustrates the challenge (and it might help others trying to work with MapPoint circles, pushpins, colors, latitude and longitude).
Any ideas?
The Lone Turtle
Public Sub IllustrationCircles()
Dim objApp As MapPoint.Application
Set objApp = CreateObject("MapPoint.application")
Dim objMap As MapPoint.Map
Set objMap = objApp.ActiveMap
Dim objPin As MapPoint.Pushpin
Dim objLocS As MapPoint.Location
objApp.Visible = True
objApp.UserControl = True
Dim ObjCount As Integer
Dim dblLat As Double
Dim dblLon As Double
Dim dblRadius As Double
' For Averages
Dim AdblLat As Double
Dim AdblLon As Double
'For Weighted Average
Dim WdblLat As Double
Dim WdblLon As Double
Dim WdblRadius As Double
Dim vbColorValue As Long
objApp.WindowState = geoWindowStateMaximize
objApp.PaneState = geoPaneNone
objMap.Altitude = 100
' could be anwhere from 3-9
For ObjCount = 1 To 8
Select Case ObjCount
Case 1
dblLat = 48.6280056894734
dblLon = -99.378787241166
dblRadius = 6.18
vbColorValue = vbBlack
Case 2
dblLat = 48.4999341491519
dblLon = -99.7047368939117
dblRadius = 10.11
vbColorValue = vbBlue
Case 3
dblLat = 48.6619616705644
dblLon = -99.8449472515777
dblRadius = 15.16
vbColorValue = vbCyan
Case 4
dblLat = 48.8583044956192
dblLon = -99.6143183198339
dblRadius = 16.05
vbColorValue = vbGreen
Case 5
dblLat = 48.7911111785395
dblLon = -99.2499805227612
dblRadius = 16.18
vbColorValue = vbMagenta
Case 6
dblLat = 48.4910139668177
dblLon = -99.2037748116962
dblRadius = 17.37
vbColorValue = vbRed
Case 7
dblLat = 48.6293351829129
dblLon = -99.0992993329416
dblRadius = 18.99
vbColorValue = vbWhite
Case 8
dblLat = 48.3418501927391
dblLon = -99.6915830663967
dblRadius = 21.93
vbColorValue = vbYellow
End Select
Set objLocS = objMap.GetLocation(dblLat, dblLon)
objMap.Shapes.AddShape geoShapeRadius, objLocS, dblRadius * 2, dblRadius * 2
If vbColorValue = vbBlue Then
objMap.Shapes.Item(ObjCount).Line.Weight = 10
Else
objMap.Shapes.Item(ObjCount).Line.Weight = 1
End If
objMap.Shapes.Item(ObjCount).Line.ForeColor = vbColorValue
'For Average
AdblLat = AdblLat + dblLat
AdblLon = AdblLon + dblLon
'For Weighted Average
WdblLat = WdblLat + (dblLat * dblRadius)
WdblLon = WdblLon + (dblLon * dblRadius)
WdblRadius = WdblRadius + dblRadius
Next ObjCount
Set objPin = objMap.AddPushpin(objMap.GetLocation(WdblLat / WdblRadius, WdblLon / WdblRadius), "Weighted Lat & Long")
objPin.BalloonState = geoDisplayBalloon
objPin.Symbol = 250
Set objPin = objMap.AddPushpin(objMap.GetLocation(AdblLat / 8, AdblLon / 8) , "Average Lat & Long")
objPin.BalloonState = geoDisplayBalloon
objPin.Symbol = 228
Set objLocS = objMap.GetLocation(48.62191, -99.55227)
objLocS.Goto
objMap.Altitude = 12
objMap.Shapes.AddTextbox objLocS, 125, 100
objMap.Shapes.Item(9).Text = "Notice the vbBlue Circle does Not intersect with more than one circle (vbBlack or vbMagenta), toss it?"
Set objLocS = objMap.GetLocation(48.63562, -99.51499)
objLocS.Goto
objMap.Shapes.AddTextbox objLocS, 100, 50
objMap.Shapes.Item(10).Text = "This is the desired result (48.63562, -99.51499)."
objApp.ActiveMap.Saved = True
End Sub