In my last blog, I demonstrated how you can import a map image from Maps Live, and calibrate it in preparation for importing any KML files into it (Moving Between Visio and KML). In this blog, I will complete the import of KML files exported from Maps Live.
I created two base map images in Visio, side by side, so that I can demonstrate that the import can be done to any prepared image, anywhere in Visio. Of course, you could have the two images on top of each other, on different layers, so that you can switch between Road and Aerial view by just changing the visibility of their layers.
In my demonstration, I have prepared a KML file with an area (polygons), three paths (linestrings) and three pushpins (points). You may spot that there are only two shown on each map, well, that is because I have put a filter in the import to only bring in those parts that are within the map image boundary.
In addition to the geometry for each shape, I have added Shape Data/Custom Properties and assigned the different types of shapes on to discrete layers in Visio.
In order to convert the KML files into Visio, I had to choose how the different types of Placemarks are to be represented:
Getting the Map
Firstly, you need to get the size and position of the selected map shape and read its Shape Data/Custom Properties in order to understand the extents of the earth under consideration. Then the only difficulty was transforming the geometry from longitudes/latitudes of each Placemark relative to the selected map shape.
If shpMap.CellExists(“Prop.MinLon”, Visio.visExistsAnywhere) = 0 Then
MsgBox “Please select a map shape”
Exit Sub
End If
Dim nod As MSXML2.IXMLDOMNode
Set nod = xdoc.SelectSingleNode(“//kml/Document/Placemark/name”)
If Not nod Is Nothing Then
setProp shpMap, “Name”, “Name”, 0, “””” & nod.Text & “”””
Else
setProp shpMap, “Name”, “Name”, 0, “”
End If
Set nod = xdoc.SelectSingleNode(“//kml/Document/Placemark/description”)
If Not nod Is Nothing Then
setProp shpMap, “Description”, “Description”, 0, “””” & nod.Text & “”””
Else
setProp shpMap, “Description”, “Description”, 0, “”
End If
Dim dWidth As Double
dWidth = shpMap.Cells(“Width”).ResultIU
Dim dHeight As Double
dHeight = shpMap.Cells(“Height”).ResultIU
Dim dLeft As Double
dLeft = shpMap.Cells(“PinX”).ResultIU – shpMap.Cells(“LocPinX”).ResultIU
Dim dBottom As Double
dBottom = shpMap.Cells(“PinY”).ResultIU – shpMap.Cells(“LocPinY”).ResultIU
Dim dMinLon As Double
dMinLon = shpMap.Cells(“Prop.MinLon”).ResultIU
Dim dMinLat As Double
dMinLat = shpMap.Cells(“Prop.MinLat”).ResultIU
Dim dMaxLon As Double
dMaxLon = shpMap.Cells(“Prop.MaxLon”).ResultIU
Dim dMaxLat As Double
dMaxLat = shpMap.Cells(“Prop.MaxLat”).ResultIU
Collecting the Styles, etc
Every Placemark created by the export from Maps Live to KML has a corresponding Style element for its line color, weight and transparency and fill color and transparency. These values are stored separately within the KML file created by Maps Live (note that this is not necessary in the KML specification, and some tools do export the style information within the Placemark element).
Dim i As Integer
Dim j As Integer
Dim styles As MSXML2.IXMLDOMNodeList
Dim style As MSXML2.IXMLDOMElement
Dim dicStyles As New Dictionary
‘Collect the styles into a dictionary
Set styles = xdoc.getElementsByTagName(“Style”)
For i = 1 To styles.Length
Set style = styles.Item(i – 1)
setStyle style, dicStyles
Next i
Dim name As String
Dim description As String
Dim styleUrl As String
Dim aStyle(2) As String
Dim lineStyleColor As String
Dim lineStyleWidth As String
Dim polyStyleColor As String
Dim placemark As MSXML2.IXMLDOMElement
Dim vertexes As Variant
Dim shpNew As Visio.Shape
Dim xyArray() As Double
Areas (Polygons)
The choice of geometry type was pretty straight forward because Visio has a DrawPolyline(…) method for a Page object, so, after converting from lonlats to Visio geometry, the ShapeSheet looks something like this:
The partial code that achieves this is shown below:
Dim polygons As MSXML2.IXMLDOMNodeList
Dim polygon As MSXML2.IXMLDOMElement
'Loop thru the polygons
Set polygons = xdoc.getElementsByTagName("Polygon")
addLayer shpMap.ContainingPage, "Polygon"
For i = 1 To polygons.Length
Set polygon = polygons.Item(i - 1)
setCoords polygon, vertexes
For j = 0 To UBound(vertexes, 2)
ReDim Preserve xyArray(1 To ((j + 1) * 2))
xyArray(((j + 1) * 2) - 1) = dLeft + ((CDbl(vertexes(0, j) - dMinLon) / (dMaxLon - dMinLon)) * dWidth)
xyArray((j + 1) * 2) = dBottom + ((CDbl(vertexes(1, j) - dMinLat) / (dMaxLat - dMinLat)) * dHeight)
Next j
'Ensure that the shape starts or ends within the map shape
If shpMap.HitTest(xyArray(1), xyArray(2), 0) > 0 _
And shpMap.HitTest(xyArray(UBound(xyArray) - 3), xyArray(UBound(xyArray) - 2), 0) > 0 Then
Set placemark = polygon.ParentNode
setAttribs placemark, name, description, styleUrl
lineStyleColor = dicStyles(Mid(styleUrl, 2))(0)
lineStyleWidth = dicStyles(Mid(styleUrl, 2))(1)
polyStyleColor = dicStyles(Mid(styleUrl, 2))(2)
Set shpNew = shpMap.ContainingPage.DrawPolyline(xyArray, 0)
shpNew.Cells("LineColor").FormulaU = "=RGB(" & HexToDecimal(Mid(lineStyleColor, 7, 2)) & _
"," & HexToDecimal(Mid(lineStyleColor, 5, 2)) & "," & HexToDecimal(Mid(lineStyleColor, 3, 2)) & ")"
shpNew.Cells("LineColorTrans").FormulaU = "=" & CInt(HexToDecimal(Mid(lineStyleColor, 1, 2)) * 100 / 255) & " %"
shpNew.Cells("LineWeight").FormulaU = "=" & lineStyleWidth & " pt"
shpNew.Cells("FillForegnd").FormulaU = "=RGB(" & HexToDecimal(Mid(polyStyleColor, 7, 2)) & _
"," & HexToDecimal(Mid(polyStyleColor, 5, 2)) & "," & HexToDecimal(Mid(polyStyleColor, 3, 2)) & ")"
shpNew.Cells("FillForegndTrans").FormulaU = "=" & CInt(HexToDecimal(Mid(polyStyleColor, 1, 2)) * 100 / 255) & " %"
shpNew.name = "Polygon_" & Format(i, "000")
setProp shpNew, "Name", "Name", 0, """" & name & """"
setProp shpNew, "Description", "Description", 0, """" & description & """"
shpMap.ContainingPage.Layers("Polygon").Add shpNew, 0
End If
Next i
Paths (LineStrings)
I decided to use the DrawPolyline method for LineStrings too, however, I discovered there is a bug in Visio that means that a Polyline with NoFill set to True cannot be found by SpatialNeighbors. This is important because I plan to use the SpatialNeighbors function later for exporting Kml. However, I found a workaround, which is to set the NoFill to False, but to set the FillPattern to 0 (None).
Dim linestrings As MSXML2.IXMLDOMNodeList
Dim linestring As MSXML2.IXMLDOMElement
Set linestrings = xdoc.getElementsByTagName("LineString")
addLayer shpMap.ContainingPage, "LineString"
For i = 1 To linestrings.Length
Set linestring = linestrings.Item(i - 1)
setCoords linestring, vertexes
For j = 0 To UBound(vertexes, 2)
ReDim Preserve xyArray(1 To ((j + 1) * 2))
xyArray(((j + 1) * 2) - 1) = dLeft + ((CDbl(vertexes(0, j) - dMinLon) / (dMaxLon - dMinLon)) * dWidth)
xyArray((j + 1) * 2) = dBottom + ((CDbl(vertexes(1, j) - dMinLat) / (dMaxLat - dMinLat)) * dHeight)
Next j
'Ensure that the shape starts or ends within the map shape
If shpMap.HitTest(xyArray(1), xyArray(2), 0) > 0 _
And shpMap.HitTest(xyArray(UBound(xyArray) - 1), xyArray(UBound(xyArray)), 0) > 0 Then
Set placemark = linestring.ParentNode
setAttribs placemark, name, description, styleUrl
'Exclude the MDL shape, if present
If Not name = MDDLName Then
lineStyleColor = dicStyles(Mid(styleUrl, 2))(0)
lineStyleWidth = dicStyles(Mid(styleUrl, 2))(1)
Set shpNew = shpMap.ContainingPage.DrawPolyline(xyArray, 0)
shpNew.Cells("LineColor").FormulaU = "=RGB(" & HexToDecimal(Mid(lineStyleColor, 7, 2)) & _
"," & HexToDecimal(Mid(lineStyleColor, 5, 2)) & "," & HexToDecimal(Mid(lineStyleColor, 3, 2)) & ")"
shpNew.Cells("LineColorTrans").FormulaU = "=" & CInt(HexToDecimal(Mid(lineStyleColor, 1, 2)) * 100 / 255) & " %"
shpNew.Cells("LineWeight").FormulaU = "=" & lineStyleWidth & " pt"
shpNew.name = "Linestring_" & Format(i, "000")
setProp shpNew, "Name", "Name", 0, """" & name & """"
setProp shpNew, "Description", "Description", 0, """" & description & """"
'A Polyline with NoFill set to True cannot be found by SpatialNeighbors
shpNew.Cells("Geometry1.NoFill").FormulaU = False
shpNew.Cells("FillPattern").FormulaU = 0
shpMap.ContainingPage.Layers("LineString").Add shpNew, 0
End If
End If
Next i
PushPins (Points)
I could have considered translating a pushpin as an instance of a Visio master, but I thought that I would keep it simple (for now) and use the DrawEllipse function. Of course, you need to do a little displacement to account for PinX/Y of the ellipse being in the centre of the shape.
Dim pins As MSXML2.IXMLDOMNodeList
Dim pin As MSXML2.IXMLDOMElement
Const PinRadius As Double = 0.1
Set pins = xdoc.getElementsByTagName(“Point”)
addLayer shpMap.ContainingPage, “Point”
For i = 1 To pins.Length
Set pin = pins.Item(i – 1)
setCoords pin, vertexes
For j = 0 To UBound(vertexes, 2)
ReDim Preserve xyArray(1 To ((j + 1) * 2))
xyArray(((j + 1) * 2) – 1) = dLeft + ((CDbl(vertexes(0, j) – dMinLon) / (dMaxLon – dMinLon)) * dWidth)
xyArray((j + 1) * 2) = dBottom + ((CDbl(vertexes(1, j) – dMinLat) / (dMaxLat – dMinLat)) * dHeight)
Next j
‘Ensure that the shape is within the map
If shpMap.HitTest(xyArray(1), xyArray(2), 0) > 0 Then
Set placemark = pin.ParentNode
setAttribs placemark, name, description, styleUrl
Set shpNew = shpMap.ContainingPage.DrawOval(xyArray(1) – PinRadius, xyArray(2) + PinRadius, _
xyArray(1) + PinRadius, xyArray(2) – PinRadius)
shpNew.Cells(“LineColor”).FormulaU = “=RGB(255,0,0)”
shpNew.Cells(“FillForegnd”).FormulaU = “=RGB(255,0,0)”
shpNew.name = “Point_” & Format(i, “000”)
setProp shpNew, “Name”, “Name”, 0, “””” & name & “”””
setProp shpNew, “Description”, “Description”, 0, “””” & description & “”””
shpMap.ContainingPage.Layers(“Point”).Add shpNew, 0
End If
Next i
Finally
Just to finish off neatly, I returned the selection to the original target map shape
Visio.ActiveWindow.DeselectAll
Visio.ActiveWindow.Select shpMap, Visio.VisSelectArgs.visSelect
Well, that completes my demonstration of how you can import KML files into Visio, although there are some refinements and additions that one can make. For example, it would be fairly trivial to create hyperlinks on each shape for any moreInfoUrl or photoUrl elements that are found.
I have uploaded the Visio file and sample KML file for downloading from : VisioKML.zip
I have started looking at creating KML files from Visio now…..
