Everyone knows that you can change the colour of Visio shapes. Most people know that you can also change the fill pattern too.
Coding
Automating Area and Perimeter Length Shape Data
[UPDATE: Microsoft introduced a new function into Visio 2010 called PATHLENGTH(…), so some of the following is now not required. See Automatic Line and Segment Lengths in Visio )
Another newsgroup question has asked about automating the update of shape area and perimeter lengths. Now, this is an area (no pun intended) that I am most interested in because I used to do a lot of space planning. Visio Professional does include Space and Boundary shapes on the Resources stencil that use an add-in to update the area, but does nothing about the perimeter length. These shapes do highlight some of the issues to be considered though…
- Visio pages can be scaled, and indeed the various floor plan and site layout templates in Visio are pre-scaled. Most templates are not scaled, and therefore default to 1:1 scale.
- Visio measures everything internally in inches, although you can display in almost whatever units you choose.
- The Visio Application object has a handy ConvertResult (StringOrNumber, UnitsIn, UnitsOut) method, which can be used for linear and area measurements … and can also be used for date and times.
- Visio can store decimal numbers to a very high degree of precision (I counted 14 decimal places), but you almost always want to format the display.
- Visio can call a method in a VBA project when the values in specified cells are changed.
- It is easy to display Shape Data in a shape, either by using Data Graphics or by Insert Field
[Read more…] about Automating Area and Perimeter Length Shape Data
Listing Connections in Visio 2010
One of the best bits of Visio is the connections between shapes, but it has always been difficult to understand these connections in code. There are connections to and from shapes, which require you to understand where you are and which way to look … at the beginning or the end of a 1D connector. Visio 2010 has added some useful extra methods to the shape object which makes understanding connections much easier. This post will show you how you can use the new GluedShapes() and ConnectedShapes() methods.
Take, for example, a network diagram where there are connections between servers and routers:
You may wish to list the connections at the start and end of each cable. Previously, this would have meant inspecting the connected cell to see if was at the beginning or end of the line, but now you can use the GluedShapes() method of a shape to retrieve an array of the 2D shapes connected at one end or another with the relevant arguments, visGluedShapesIncoming2D or visGluedShapesOutgoing2D. The ListGluedConnections macro below displays the following in the immediate window:
Connector Dynamic connector
> Router.45 router-02
< Server server-01 Connector Dynamic connector.107 > Router.45 router-02
< Server.30 server-02 Connector Dynamic connector.108 > Router router-01
< Server.75 server-03 Connector Dynamic connector.109 > Router.91 router-03
< Server.30 server-02 Connector Dynamic connector.110 > Router.91 router-03
< Server server-01
Public Sub ListGluedConnections() Dim shp As Visio.Shape Dim connectorShape As Visio.Shape Dim sourceShape As Visio.Shape Dim targetShape As Visio.Shape Dim aryTargetIDs() As Long Dim arySourceIDs() As Long Dim targetID As Long Dim sourceID As Long Dim i As Integer For Each shp In Visio.ActivePage.Shapes If shp.OneD Then Debug.Print "Connector", shp.Name arySourceIDs = shp.GluedShapes(visGluedShapesIncoming2D, "") For i = 0 To UBound(arySourceIDs) Set sourceShape = Visio.ActivePage.Shapes.ItemFromID(arySourceIDs(i)) If sourceShape.CellExists("Prop.NetworkName", Visio.visExistsAnywhere) Then Debug.Print , ">", sourceShape.Name, sourceShape.Cells("Prop.NetworkName").ResultStr("") End If Next aryTargetIDs = shp.GluedShapes(visGluedShapesOutgoing2D, "") For i = 0 To UBound(aryTargetIDs) Set targetShape = Visio.ActivePage.Shapes.ItemFromID(aryTargetIDs(i)) If targetShape.CellExists("Prop.NetworkName", Visio.visExistsAnywhere) Then Debug.Print , "<", targetShape.Name, targetShape.Cells("Prop.NetworkName").ResultStr("") End If Next End If Next End Sub
Similarly, you may want to simply list the next connected 2D shape, effectively ignoring the cable. In this case, you can use the new ConnectedShapes() method, with the relevant arguments visGluedShapesIncoming2D or visGluedShapesOutgoing2D, to produce an output like the following ( using the ListNextConnections macro below):
Shape Server server-01
> Router.45 router-02
> Router.91 router-03
Shape Router router-01
< Server.75 server-03 Shape Server.30 server-02 > Router.45 router-02
> Router.91 router-03
Shape Router.45 router-02
< Server server-01
< Server.30 server-02 Shape Server.75 server-03 > Router router-01
Shape Router.91 router-03
< Server server-01
< Server.30 server-02
Public Sub ListNextConnections() Dim shp As Visio.Shape Dim connectorShape As Visio.Shape Dim sourceShape As Visio.Shape Dim targetShape As Visio.Shape Dim aryTargetIDs() As Long Dim arySourceIDs() As Long Dim targetID As Long Dim sourceID As Long Dim i As Integer For Each shp In Visio.ActivePage.Shapes If Not shp.OneD Then If shp.CellExists("Prop.NetworkName", Visio.visExistsAnywhere) Then Debug.Print "Shape", shp.Name, shp.Cells("Prop.NetworkName").ResultStr("") arySourceIDs = shp.ConnectedShapes(visConnectedShapesOutgoingNodes, "") For i = 0 To UBound(arySourceIDs) Set sourceShape = Visio.ActivePage.Shapes.ItemFromID(arySourceIDs(i)) If sourceShape.CellExists("Prop.NetworkName", Visio.visExistsAnywhere) Then Debug.Print , "<", sourceShape.Name, sourceShape.Cells("Prop.NetworkName").ResultStr("") End If Next aryTargetIDs = shp.ConnectedShapes(visConnectedShapesIncomingNodes, "") For i = 0 To UBound(aryTargetIDs) Set targetShape = Visio.ActivePage.Shapes.ItemFromID(aryTargetIDs(i)) If targetShape.CellExists("Prop.NetworkName", Visio.visExistsAnywhere) Then Debug.Print , ">", targetShape.Name, targetShape.Cells("Prop.NetworkName").ResultStr("") End If Next End If End If Next End Sub
I think this makes interrogation of connected diagrams, of all flavours, much simpler, though I would love to have similar ShapeSheet functions too!
Visio 2010 : Containment and Cross-Functional Flowcharts
One of the templates to get a revision in Visio 2010 is the Cross Functional Flowchart template because of the new list and containment functionality that has been added into the core application. I had to write a small bit of code in earlier versions of Visio for each flowchart shape to automatically understand which swimlane and phase it belongs to, but now there are ShapeSheet functions available, so a slight modification of a flowchart master enables it to inherit values from the swimlane that it is in. This article demonstrates who you can do this to, for example, synchronize the fill color of each flowchart shape to that of the swimlane that it belongs to.
[Read more…] about Visio 2010 : Containment and Cross-Functional Flowcharts
Copying Data from one Shape to Another
A recent newsgroup question asked for example code to demonstrate how shape data can be copied from one shape to another via a connector between the two. This is something that others might want to do also, and not just by connecting shapes, but also by selection since you might change your mind about which shape to use, but you have already entered a lot of information on the original shape. A good example of this might be when diagramming a network and needing to change between one type of server and another. So, in this blog, I will demonstrate how shape data can be transferred by connection or by selection, and how to limit the transfer to rows that match by name or by label.
Note that Shape Data is the new name for Custom Properties in Visio 2007.
Firstly, I should explain why it may be necessary to match by name or by label: In the following screenshot, you can see the Shape Data window, Define Shape Data dialog, and the ShapeSheet for a Server shape. I have ticked “Run in developer mode” in Tools / Options / Advanced, otherwise I would not be able to see the Name, Sort key, Ask on drop or Hidden in the dialog.
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 (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…..