Importing KML Files into Visio

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 (http://bvisual.spaces.live.com/blog/cns!3350D61BC93733A9!752.entry).  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.

image

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 is 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.

image

I have also 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.

image

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 it’s Shape DataCustom 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:

image

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).

image

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.

image

 

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 : http://cid-3350d61bc93733a9.skydrive.live.com/self.aspx/Blogs/VisioKML.zip

I have started looking at creating KML files from Visio now…..

Posted in Visio. 1 Comment »

One Response to “Importing KML Files into Visio”

  1. D.P. Roberts Says:

    You rock!


Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

davecra.wordpress.com/

Microsoft Office Development, and more...

PowerShell.Amsterdam

Automate, Accelerate, Accurate

johnvisiomvp

Life with Visio and other Microsoft Toys!

Title (Required)

Windows Server Essentials Tips & Tricks

Nilsandrey's Weblog

Just another WordPress.com weblog

Things that Should be Easy

Every so often (too often in the IT industry) I encounter things that should have been very easy to do but turned out to be far too complicated. My favorite topics include SharePoint, .Net development, and software architecture, especially distributed systems.

Visio Guy

Shapes, Stencils, Drawings Templates, Tutorials, Tips & Developer Info for Microsoft Visio

Hannes's Virtual Earth

Tips & Tricks around Mapping and Cloud Computing

Pluralsight blog

be smart, be clear, be visual ...

%d bloggers like this: