View Single Post

  #1 (permalink)  
Old 03-04-2006
The Lone Turtle The Lone Turtle is offline
Junior Member
White Belt
 
Join Date: Nov 2005
Posts: 3
Mission Impossible? Intersection of Multiple Circles

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
Reply With Quote