[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
Therefore, I have written a method AddUpdateMetricsTrigger() which will add some Shape Data rows and an Action row to the page (or Master page):
The User.UpdateMetricsTrigger cell contains a formula that calls the UpdateMetrics() method in the bVisualUtilities VBA project. It will be called whenever the Width or Height of the shape is changed, or whenever the values in the new Shape Data rows in the page are changed. It will also be called whenever the Refresh Metrics right mouse action in the page is selected.
So what happens when UpdateMetrics() is run? Simply, the Area, Area Text, Length and Length Text values in the shape are updated. Any, or all, of these can be added to the shape as Data Graphics.
The page properties control the display of the Area Text and Length Text Shape Data values.
The user can change the display units and format for both area and the perimeter length. This will be immediately updated by all shapes that have the User.UpdateMetricsTrigger formula. Possibly the best way of using this utility is to create a master shape that already has the cells added, then just drag and drop them onto a page.
This is the code listing for the bVisualMetrics module in the bVisualUtilities VBA project:
First, I declared some constants for the name of the Shape Data rows on the shapes, the area and length units and the format strings. These last three items will appear as fixed lists on the Page Shape Data rows.
Option Explicit
'These cells will be added to the page when the UpdateMaster is dropped onto a page
Const actionUpdateCell As String = "Actions.UpdateMetrics"
Const areaUnitCell As String = "Prop.AreaUnits"
Const areaUnits As String = "sq in;sq ft;sq yd;acres;sq mi;sq mm;sq cm;sq m;ha;sq km"
Const areaFormatCell As String = "Prop.AreaFormat"
Const lengthUnitCell As String = "Prop.LengthUnits"
Const lengthUnits As String = "in;ft;yd;nm;mi;mm;cm;m;km" 'nm=nautical mile
Const lengthFormatCell As String = "Prop.LengthFormat"
Const formats As String = "0;0.0;0.00;0.000;0.0000;0.00000;0.000000"
Const areaCell As String = "Prop.Area"
Const areaTextCell As String = "Prop.AreaText"
Const lengthCell As String = "Prop.Length"
Const lengthTextCell As String = "Prop.LengthText"
The AddUpdateMetricsTrigger() needs to run to prepare the shape and page (it can be run on the shape in the Master Edit window). [Actually this following listing is incomplete because I had trouble uploading it all …. so please download the code at the end of this article]
Public Sub AddUpdateMetricsTrigger()
Dim shp As Visio.Shape
Dim iSect As Integer
Dim iRow As Integer
Dim pag As Visio.Shape
For Each shp In Visio.ActiveWindow.Selection
If Not shp.ContainingMaster Is Nothing Then
Set pag = shp.ContainingMaster.PageSheet
ElseIf Not shp.ContainingPage Is Nothing Then
Set pag = shp.ContainingPage.PageSheet
End If
iSect = Visio.VisSectionIndices.visSectionProp
If pag.SectionExists(iSect, Visio.VisExistsFlags.visExistsAnywhere) = 0 Then
pag.AddSection iSect
End If
If pag.CellExists(areaUnitCell, Visio.visExistsAnywhere) = 0 Then
iRow = pag.AddNamedRow(iSect, Split(areaUnitCell, ".")(1), 0)
pag.CellsSRC(iSect, iRow, Visio.VisCellIndices.visCustPropsLabel).FormulaU = _
"=""Area Units"""
pag.CellsSRC(iSect, iRow, Visio.VisCellIndices.visCustPropsType).FormulaU = _
"=1"
pag.CellsSRC(iSect, iRow, Visio.VisCellIndices.visCustPropsFormat).FormulaU = _
"=""" & areaUnits & """"
pag.CellsSRC(iSect, iRow, Visio.VisCellIndices.visCustPropsValue).FormulaU = _
"=INDEX(0," & areaUnitCell & ".Format)"
End If
Next
Sub
The UpdateMetrics() method is called from each shape when the values in specified cells change:
Public Sub UpdateMetrics(ByVal shp As Visio.Shape)
Dim dbl As Double
Dim dblConv As Double
Dim txt As String
Dim fmt As String
Dim units As String
Dim ratio As Double
Dim iSect As Integer
Dim iRow As Integer
Dim pag As Visio.Shape
If Not shp.ContainingMaster Is Nothing Then
Set pag = shp.ContainingMaster.PageSheet
ElseIf Not shp.ContainingPage Is Nothing Then
Set pag = shp.ContainingPage.PageSheet
End If
If pag Is Nothing Then
Exit Sub
End If
ratio = pag.Cells("DrawingScale").ResultIU / pag.Cells("PageScale").ResultIU
iSect = Visio.VisSectionIndices.visSectionProp
If UCase(Left(areaCell, 5)) = "PROP." Or UCase(Left(areaTextCell, 5)) = "PROP." Or _
UCase(Left(lengthCell, 5)) = "PROP." Or UCase(Left(lengthTextCell, 5)) = "PROP." Then
If shp.SectionExists(iSect, Visio.VisExistsFlags.visExistsAnywhere) = 0 Then
shp.AddSection iSect
End If
End If
'Update the area
If shp.CellExists(areaCell, Visio.visExistsAnywhere) Then
dbl = shp.AreaIU(False)
fmt = pag.Cells(areaFormatCell).ResultStr("")
units = pag.Cells(areaUnitCell).ResultStr("")
dblConv = Application.ConvertResult(dbl, "sq in", units)
shp.Cells(areaCell).FormulaU = dblConv
shp.Cells(areaTextCell).FormulaU = """" & Format(dblConv, fmt) & " " & units & """"
End If
'Update the length
If shp.CellExists(lengthCell, Visio.visExistsAnywhere) Then
dbl = shp.LengthIU(False)
fmt = pag.Cells(lengthFormatCell).ResultStr("")
units = pag.Cells(lengthUnitCell).ResultStr("")
dblConv = Application.ConvertResult(dbl, "in", units)
shp.Cells(lengthCell).FormulaU = dblConv
shp.Cells(lengthTextCell).FormulaU = """" & Format(dblConv, fmt) & " " & units & """"
End If
End Sub
You can download the stencil that contains the VBA code here : bVisualUtilities.vss