Displaying Document Fonts

There have been some posts recently about fonts may not displaying correctly in Visio, the Viewer, or in exports to PDF or XPS.  So, I thought it would be good to be have a bit of code that enables you to see all of the different fonts on a Visio page.  You can then use it to select a font, or to check how they are seen in different formats.

image

The following code will divide the active Visio page into three columns, creating a separate shape for each font name in order.  The font index and name are displayed in the particular font, but the ScreenTip of each shape displays the information, just in case you can’t read it in the shape!

Public Sub DisplayFonts()
Dim fnt As Visio.Font
Dim shp As Visio.Shape
Dim cols As Integer
Dim col As Integer
Dim maxRows As Integer
Dim row As Integer

Dim x1 As Double
Dim y1 As Double
Dim x2 As Double
Dim y2 As Double
Dim width As Double
Dim height As Double

    cols = 3
    col = 0
    maxRows = CInt(1 + (Visio.ActiveDocument.Fonts.Count / cols))
    width = ((Visio.ActivePage.PageSheet.Cells("PageWidth").ResultIU – _
            Visio.ActivePage.PageSheet.Cells("PageLeftMargin").ResultIU – _
            Visio.ActivePage.PageSheet.Cells("PageRightMargin").ResultIU) / cols)
    height = ((Visio.ActivePage.PageSheet.Cells("PageHeight").ResultIU – _
            Visio.ActivePage.PageSheet.Cells("PageTopMargin").ResultIU – _
            Visio.ActivePage.PageSheet.Cells("PageBottomMargin").ResultIU) / maxRows)

    For Each fnt In Visio.ActiveDocument.Fonts

        If row Mod maxRows = 0 Then
            col = col + 1
        End If

        row = row + 1
        x1 = Visio.ActivePage.PageSheet.Cells("PageLeftMargin").ResultIU + (col – 1) * (width)
        y1 = Visio.ActivePage.PageSheet.Cells("PageHeight").ResultIU – _
            Visio.ActivePage.PageSheet.Cells("PageTopMargin").ResultIU – _
            ((row – ((col – 1) * maxRows) – 1) * height)
        x2 = x1 + (Visio.ActivePage.PageSheet.Cells("PageWidth").ResultIU / cols)
        y2 = y1 + height
        Set shp = Visio.ActivePage.DrawRectangle(x1, y1, x2, y2)
        shp.Text = fnt.ID & vbTab & fnt.Name
        shp.Cells("Para.HorzAlign").Formula = "=0"
        shp.Cells("Geometry1.NoFill").Formula = "=1"
        shp.Cells("Geometry1.NoLine").Formula = "=1"
        shp.Cells("Char.Size").Formula = "=8 pt"
        shp.Cells("Char.Font").Formula = "=" & CStr(fnt.ID)
        shp.Cells("Comment").Formula = "=""" & fnt.ID & vbCrLf & fnt.Name & """"
    Next
End Sub

Toggling Layers On and Off

Visio layering system is more complex than any CAD system I’ve worked with, and often catches users out.  A Visio shape can belong to no layer, one layer or multiple layers simultaneously, and a layer can be visible or invisible; printable or non-printable.  In fact, you can have a shape on a layer that is invisible but printable – a good way to put a watermark across a document.

Firstly, Visio layers are per page in a document, and secondly, Visio layers are stored as an index number with an associated name.  Therefore, layer 1 on page 1 could be named Outline, but layer 1 on page 2 could be called something completely different!

View > Layer Properties will show you the layer settings on the active Visio page, but the # column, which gives you a count of shapes on each layer, can be misleading because the same shape can be on multiple layers, and even sub-shapes (those inside a grouped shape) are counted.

image

Layers have nothing to do with Z-order, therefore a shape on layer 1 may be behind or in-front of a shape on layer 2.  The commands Bring To Front, Bring Forwards, Send To Back and Send Backwards change the Z-order, not the layer.

Usually, you want to be able to quickly switch a layer of and on, however the manual method using the Layer Properties dialog requires you to open it first, then to click both the Visible and Print columns for the layer.  This can get even more complicated when you consider that you usually want to toggle the visibility/printability of a group of layers simultaneously.

To demonstrate the complexity of layers, and as a practical visual aid, I have created the Toggle Layer Button shape.  This shape is based on the Colored block master on the Marketing Diagrams stencil.  I have added a Circle shape into the Master group so that you can easily see if a particular layer, or group of layers, is on or off.  Also, the Circle shape adopts any layer colors assigned.

Download files from here: http://cid-3350d61bc93733a9.skydrive.live.com/self.aspx/Public/ToggleLayer.zip

image

The Toggle Layer Button shape has a number of right mouse actions, and a double-click action.  The first right mouse action to use is Read Shapes Layers which will run the ReadShapesLayers macro, but first you need to select the button shape then SHIFT+Select the other shapes whose layers you want to assign to the button.

 image

The double-click event runs the DoToggleLayers macro, which will read the layers listed in the text of the button, and then toggle the visibility/printability of each of them.

image

In the first example, the flowchart comprises of three Flowchart shapes, which are on the Flowchart layer, connected by two Dynamic connectors, on the Connector layer.  I have used one button that is assigned to the Flowchart layer, and one which is assigned to the Connector layer.

image

In the second example, I grouped the flowchart and assigned the layer, called Both, to the group, with preserver Group Member Layers checked.  I then assigned the button to the group shape, which thus read all of the layers of the group and sub-shapes.

image

In the third example, I removed the Both layer assignment of each sub-shape, leaving them only on their original layer.  The group shape is assigned to the Both layer only.

image

Then I clicked the Flowchart button, which turned off the visibility/printability of the Flowchart layer.  Notice that the Circle sub-shape of the Flowchart button is invisible, indicating that the Flowchart layer is switched off.  Also notice that the Flowchart shapes in the second column are still visible because they are also assigned to the Both layer.

image

I then toggled the Flowchart button again, and toggled the Connector button off.  This time the Dynamic connector shapes are invisible.

image

I then toggled the button that is assigned to all three layers, causing all layers to be invisible.

image

Finally, I toggled all layers back on and toggled off just the Both layer.  This caused all shapes to be visible, but only the un-grouped flowchart on the left is selectable.

image

The other use for the Circle shape is to indicate the colors assigned to each layer.  This is done automatically when you use the Layer Properties dialog.

image

So, just having the Both layer visible/printable and with Cyan color assigned to it, results in all but the center flowchart being invisible.

image

I placed the Toggle Layer Button on a stencil called Toggle Layer, and included the following VBA code in the stencil project.  I also included code to change the Z-Order of assigned layers too, just for good measure:

Option Explicit

Public Sub DoToggleLayers(ByRef shp As Visio.Shape)
Dim pag As Visio.Page
Dim lyr As Visio.Layer
Dim aryLayer() As String
Dim sLayer As String
Dim iLayer As Integer

    Set pag = shp.ContainingPage
    aryLayer = Split(shp.Text, vbCrLf)
    For iLayer = 0 To UBound(aryLayer)
        sLayer = aryLayer(iLayer)
        For Each lyr In pag.Layers
            If UCase(lyr.Name) = UCase(sLayer) Then
                lyr.CellsC(Visio.visLayerVisible).Formula = Abs(Not (CBool(lyr.CellsC(Visio.visLayerVisible).ResultIU)))
                lyr.CellsC(Visio.visLayerPrint).Formula = Abs(Not (CBool(lyr.CellsC(Visio.visLayerPrint).ResultIU)))
                Exit For
            End If
        Next lyr
    Next iLayer
End Sub

Private Function getShapesOnLayer(ByVal shpButton As Visio.Shape) As Collection
‘Return a collection of selections
Dim col As New Collection
Dim pag As Visio.Page
Dim lyr As Visio.Layer
Dim sLayer As String
Dim sel As Visio.Selection
Dim aryLayer() As String
Dim iLayer As Integer

    Set pag = shpButton.ContainingPage
    aryLayer = Split(shpButton.Text, vbCrLf)
    For iLayer = 0 To UBound(aryLayer)
        sLayer = aryLayer(iLayer)
        Set lyr = pag.Layers(sLayer)
        ‘Only get the top level shapes
        Set sel = pag.CreateSelection(visSelTypeByLayer, visSelModeOnlySuper, lyr)
        col.Add sel
    Next iLayer
    Set getShapesOnLayer = col
End Function

Public Sub SendLayersToBack(ByRef shp As Visio.Shape)
    Dim col As Collection
    Dim iSel As Integer
    Dim sel As Visio.Selection
    Set col = getShapesOnLayer(shp)
    For iSel = 1 To col.Count
        Set sel = col.Item(iSel)
        sel.SendToBack
    Next iSel
End Sub

Public Sub SendLayersBackward(ByRef shp As Visio.Shape)
    Dim col As Collection
    Dim iSel As Integer
    Dim sel As Visio.Selection
    Set col = getShapesOnLayer(shp)
    For iSel = 1 To col.Count
        Set sel = col.Item(iSel)
        sel.SendBackward
    Next iSel
End Sub

Public Sub BringLayersForward(ByRef shp As Visio.Shape)
    Dim col As Collection
    Dim iSel As Integer
    Dim sel As Visio.Selection
    Set col = getShapesOnLayer(shp)
    For iSel = 1 To col.Count
        Set sel = col.Item(iSel)
        sel.BringForward
    Next iSel
End Sub

Public Sub BringLayersToFront(ByRef shp As Visio.Shape)
    Dim col As Collection
    Dim iSel As Integer
    Dim sel As Visio.Selection
    Set col = getShapesOnLayer(shp)
    For iSel = 1 To col.Count
        Set sel = col.Item(iSel)
        sel.BringToFront
    Next iSel
End Sub

Public Sub ReadShapesLayers(ByRef shp As Visio.Shape)
Dim shpSel As Visio.Shape
Dim shpSub As Visio.Shape
Dim sLayer As String
Dim iShape As Integer
Dim sText As String
Dim sFormula As String
Dim dic As New Dictionary

    ‘Iterate through the selection (exclusing the first shape because it is the button
    If Visio.ActiveWindow.Selection.Count > 1 Then
        For iShape = 2 To Visio.ActiveWindow.Selection.Count
            Set shpSel = Visio.ActiveWindow.Selection.Item(iShape)
            getShapeLayers shpSel, dic, sText, sFormula
            ‘Iterate through sub-shapes
            For Each shpSub In shpSel.Shapes
                getShapeLayers shpSub, dic, sText, sFormula
            Next shpSub
        Next iShape
    End If
    If Len(sText) = 0 Then
        sText = "No layers"
        sFormula = """"""
    End If
    ‘Set the text of the indicator Circle sub-shape
    shp.Text = sText
    ‘Set the layers of the indicator Circle sub-shape
    shp.Shapes("Circle").CellsSRC(Visio.VisSectionIndices.visSectionObject, _
        Visio.VisRowIndices.visRowLayerMem, _
        Visio.VisCellIndices.visLayerMember).FormulaU = _
        "=""" & sFormula & """"

End Sub

Private Sub getShapeLayers(ByVal shp As Visio.Shape, ByRef dic As Dictionary, _
    ByRef sText As String, ByRef sFormula As String)

Dim lyr As Visio.Layer
Dim iLayer As Integer

    If shp.LayerCount > 0 Then
        For iLayer = 1 To shp.LayerCount
            Set lyr = shp.Layer(iLayer)
            If dic.Exists(lyr.Name) = False Then
                dic.Add lyr.Name, lyr
                ‘Get the text for the button shape
                ‘and the formula for the indicator circle
                If Len(sText) = 0 Then
                    sText = lyr.Name
                    sFormula = lyr.Row
                Else
                    sText = sText & vbCrLf & lyr.Name
                    sFormula = sFormula & ";" & lyr.Row
                End If
            End If
        Next iLayer
    End If
End Sub

Posted in Visio. 23 Comments »
Follow

Get every new post delivered to your Inbox.

Join 45 other followers