View Full Version : Creating multiple point-to-point lines

01-27-2010, 05:56 AM
Hi, I am a regular user of mappopint, but not a programmer. I am looking for a program or add-in that will allow me to create multiple lines originating from a single point to multiple destinations.

For example, I have a single distribution centre, and want to send parcels to multiple customers, so the effect is many straight lines coming from the source, to the destinations - like a starburst.

Any suggestions?


02-01-2010, 12:12 PM
I'm a new user and do not know how to do this in MapPoint, but after to get your map into a jpeg file format, you could do it using MS Paint.

I have not found an easy way to "save as" a jpeg to get my map into a power point presentation. Rigfht now I'm emailing as a picture, copying and pasting the .gif image into power point, than right clicking and "saving as" a jpeg in my pictures. What a pain. But once you have a jep of pdf you can add the lines.


Eric Frost
02-20-2010, 03:32 PM
I just posted a little Excel tool which does this --


Screenshot attached. The zipped Excel file with the macro is in the MapForums Downloads section ($19.95) but as you can imagine the code is pretty simple:

Dim MPApp As MapPoint.Application
Dim objMap As MapPoint.Map

Public Sub DrawLines()

Dim timeStart As Date
timeStart = Now()

Set MPApp = GetObject(, "MapPoint.Application")
MPApp.Visible = False
Set objMap = MPApp.ActiveMap

Dim startingLat, startingLon As Double
Dim endLat, endLon As Double
Dim startLoc, endLoc As MapPoint.Location
Dim objShape As MapPoint.Shape

Dim row, locs As Integer
row = 2

Dim minlat, minlon, maxlat, maxlon As Double
maxlat = Cells(2, 1)
minlat = Cells(2, 1)
maxlon = Cells(2, 2)
minlon = Cells(2, 2)

Do While Cells(row, 1) <> ""

Set startLoc = objMap.GetLocation(Cells(row, 1), Cells(row, 2))
Set endLoc = objMap.GetLocation(Cells(row, 3), Cells(row, 4))
maxlat = Application.Max(maxlat, Cells(row, 1), Cells(row, 3))
minlat = Application.Min(minlat, Cells(row, 1), Cells(row, 3))
maxlon = Application.Max(maxlon, Cells(row, 2), Cells(row, 4))
minlon = Application.Min(minlon, Cells(row, 2), Cells(row, 4))

Set objShape = objMap.Shapes.AddLine(startLoc, endLoc)
objShape.Line.ForeColor = Cells(row, 5)
objShape.Line.Weight = Cells(row, 6)
objShape.Line.EndArrowhead = Cells(row, 7)

row = row + 1
If row Mod 100 = 0 Then
Debug.Print row
End If

objMap.Union(Array(objMap.GetLocation(minlat, minlon), objMap.GetLocation(maxlat, maxlon))).Goto
objMap.Altitude = objMap.Altitude * 1.2
objMap.MapStyle = geoMapStyleData

MPApp.Visible = True

MsgBox ("Finished in " & Int((Now() - timeStart) * 24 * 60 * 60) & " seconds.")

End Sub

For the ZoomTo or Goto bit at the end, I had tried doing a union of all the location objects in an array, but gave up on it. :-/ I actually wrote VB6 code that does this last year, but didn't bother to hunt it down. Just keeping track with max/min variables ended up being less code anyway.

The maxlat/maxlon, etc. part uses the MAX and MIN worksheets functions (they are not part of VBA) by referencing the Application object.

Have fun! I'm sure some people could come up with some crazy looking maps using this tool :1eye: !


Eric Frost
02-20-2010, 04:42 PM
I realize I'm probably the only person who thinks this is interesting, but here's another screenshot and ptm file created using this tool.

You can download Excel macro and see the formulas used to generate the data in Excel here --