View Full Version : Drawing Drivetime Zones Around a List of Lat/Lon's

Eric Frost
09-28-2009, 03:53 PM
This was prepared by request, it allows you to set up a list of lat/lon's in Excel and draw drive-time zones around each location. You can specify the color and number of minutes for each location.



Eric Frost
07-20-2010, 03:50 PM
I created a new version of this for a MapForums Plus member who wanted to be able to specify an existing map and add the new drivetime zones on top of the existing map. If this would be useful to anybody let me know and I'll post the new version.

08-12-2012, 11:02 AM
Could this marco be adjusted to provide the option to hide the drivetime size label? I saw that this option exists on the circle around a long/lat. The labels are hiding the drive zones in my application.

Thank you.

Eric Frost
08-14-2012, 12:47 PM
Hi Nolster!

Thanks for your patience.

I have added this as an option for each row, see attached.


Just fill in "FALSE" for all the rows if you do not want the Size to show for any of the drivetime zones.



08-14-2012, 05:09 PM
Now that all of the drive time labels are hidden, I can see there is an issue with borders. This I fixed myself, just manually making the border color the same as the zone color inside the VB code. Works great at this point. Thank you for your help.

BTW - we are mapping nationwide, to show clients points of presence coverage against contracted drive time. Works incredible.

Kirsten Tisdale
02-25-2013, 04:55 AM

This looks like just what I need - I'm not a VBA expert, so it would be good to have some guidance on three points - any changes required for 2013 version, any changes required for Europe map and how could I make it use postcodes rather than lat long. Very many thanks in advance.


Eric Frost
02-25-2013, 08:33 AM
Do you mind to share 10 or so sample postcodes? I will prepare a new tool that works with postcodes and test to make sure it works properly with MP13EU.


Kirsten Tisdale
02-25-2013, 05:55 PM

Thanks for this - here are some sample postcodes:

G31 4EB

LS11 5BJ




TR10 9LY


CT11 7PR

E10 5NH

RG30 4EL


Kirsten Tisdale
02-25-2013, 05:57 PM
Sorry - should have looked at preview first - these should read, for example, G31 4EB.

Eric Frost
02-28-2013, 01:35 PM
I took a quick stab at this, see attached.

This doesn't have all the bells & whistles of some similar tools I did recently e.g. all the options in this tool -- http://www.mapforums.com/draw-circles-addresses-v3-0-a-27621.html but let me know if you want them and I can certainly add them for you.


Kirsten Tisdale
02-28-2013, 02:19 PM

Thanks for this. In the meantime I've been struggling with my VBA and have converted to EU (and realise that a problem before was asking for drivetimes round US addresses when I have European version!). And can convert postcodes to lat longs. But... it would be good to set speeds before doing the drivetimes. Is this possible?


Eric Frost
02-28-2013, 10:31 PM
Did you try setting the options via the menu? Did that have an effect?

Kirsten Tisdale
03-01-2013, 04:49 AM
I tried setting in MP inc using a speed add-on which sets default, but it made no diff to drivetime. I also tried integrating a little old macro, but that required MP to be open, and your v2 VBA up top opens a fresh copy. Then my VBA knowledge gave out - I'm going on a course at the end of the month! K

Eric Frost
03-01-2013, 07:44 AM
Yes, see the Routing Options. I'm not 100% sure these speeds affect the Drivetime polygons however. Programmatically there is the DriverProfile object which does the same thing.

Eric Frost
03-01-2013, 07:45 AM
I tried setting in MP inc using a speed add-on which sets default, but it made no diff to drivetime. I also tried integrating a little old macro, but that required MP to be open, and your v2 VBA up top opens a fresh copy. Then my VBA knowledge gave out - I'm going on a course at the end of the month! K

Hehe, do you want to post the code you have so far? I can give some pointers.

Kirsten Tisdale
03-01-2013, 09:53 AM
Eric - thanks for all your help with this - here is relevant code:

Option Explicit
Public oApp As MapPoint.Application
Public oMap As MapPoint.Map
Public oRoute As MapPoint.Route

Sub SetMappointSpeeds()
On Error Resume Next
Set oApp = GetObject(, "MapPoint.Application") 'Add
If Err.Number = 0 Then
Set oMap = oApp.ActiveMap
Set oRoute = oMap.ActiveRoute
oApp.Units = geoKm
Call SetSpeeds(oRoute)
Set oRoute = Nothing
Set oMap = Nothing
Set oApp = Nothing
End If
End Sub

Sub SetSpeeds(oRoute As MapPoint.Route)
'put the road speeds into Mappoint

oRoute.DriverProfile.Speed(1) = InputBox("Enter motorway speed in kph")
oRoute.DriverProfile.Speed(2) = InputBox("Enter dual carriageway speed")
oRoute.DriverProfile.Speed(3) = InputBox("Enter Main road speed")
oRoute.DriverProfile.Speed(4) = InputBox("Enter Minor road speed")
oRoute.DriverProfile.Speed(5) = InputBox("Enter street speed")
' If MainForm.DislikeFerriesCB = True Then
' oRoute.DriverProfile.PreferredRoads(geoRoadFerry) = 0#
' End If
End Sub

Private Sub CommandButton1_Click()
Call SetMappointSpeeds
End Sub

Eric Frost
03-01-2013, 09:58 AM
Where is it failing or what do you want to do or need help with specifically? Thanks! Eric

Kirsten Tisdale
03-01-2013, 10:35 AM

What I was originally hoping to do was to set the speeds using this code or similar, and then create drivetime zones using those speeds with your code probably in an already open map. Sounds as if I might be attempting the impossible given your comments a couple of posts ago. And also sounds as if I've not realised a potential issue with drivetime zones.


Kirsten Tisdale
03-01-2013, 11:11 AM
Eric, driving speeds do change drivetime zones - just tried. Phew, worried myself there! K

Eric Frost
03-02-2013, 09:13 AM
So are you all good with the setting speeds part and just need a loop to do the drivetime zones?

Here is the essential part of the code for the new tool I posted earlier.

Where are your postal codes coming from? Is it an Excel list or a table?

'test to see if there is a postcode in column 3 (B) for the current row
Do While Cells(nReadRow, 3) <> ""

fDriveTime = Cells(nReadRow, 5)
nColor = AssignColor(Cells(nReadRow, 6))

Set objLoc = objMap.FindAddressResults(, , , , Cells(nReadRow, 3), Cells(nReadRow, 4))(1)

objMap.AddPushpin objLoc, Cells(nReadRow, 2)

objMap.Shapes.AddDrivetimeZone objLoc, fDriveTime * geoOneMinute
objMap.Shapes.Item(nShapeIndex).Fill.Visible = True
objMap.Shapes.Item(nShapeIndex).ZOrder (geoSendBehindRoads)
objMap.Shapes.Item(nShapeIndex).Fill.ForeColor = nColor
objMap.Shapes.Item(nShapeIndex).Line.ForeColor = vbBlack
objMap.Shapes.Item(nShapeIndex).Line.Weight = 1

nShapeIndex = nShapeIndex + 1
nReadRow = nReadRow + 1