ISR Computing -

How to draw network diagrams using Visio 2007 and VBA

This article explains how to draw network diagrams using Visio 2007 and VBA.

The end result should look like the image above.

Public connectionCloud As Integer

Sub Automated_Process()

Call DrawNetworkCloud("AT&T MPLS", 1, 9.5)

Dim dblX As Double
Dim dblY As Double
dblX = 5.5
dblY = 10.5
Dim intCounter As Integer
intCounter = 0
While intCounter < 6
    intCounter = intCounter + 1
    dblY = dblY - 0.8
    Call DrawRouters(CStr(intCounter), CStr(intCounter) + " Times Square, New York, NY", dblX, dblY)
Wend


End Sub
   

Private Sub DrawRouters(siteId As String, rtrLoc As String, dblX As Double, dblY As Double)
    ' Reference: http://msdn.microsoft.com/en-us/library/ms195970.aspx
    Dim vsoShape1 As Visio.Shape
    Dim vsoShape2 As Visio.Shape
    Dim vsoMaster As Visio.Master
    Dim vsoGroupShape As Visio.Shape
    Dim vsoSelection As Visio.Selection
    ' Linking to Cisco Product Icons
    Set vsoMaster = Visio.Documents.Item("PERIPH_U.VSS").Masters.ItemU("Router")
 
    ' visRight (3) aligns name of the shape on the right
    ' Master Object Members
    Set vsoShape1 = ActivePage.Drop(vsoMaster, dblX, dblY)
    ' Reference: http://msdn.microsoft.com/en-us/library/dd483294.aspx
    Set vsoShape2 = ActivePage.DrawRectangle(dblX + 0.2, dblY, dblX + 2, dblY + 0.1)
    vsoShape2.TextStyle = "Normal"
    vsoShape2.LineStyle = "Text Only"
    vsoShape2.FillStyle = "Text Only"
    ' Create the title-shape text.
    
    Dim vsoCharacters As Visio.Characters
    Set vsoCharacters = vsoShape2.Characters
    vsoCharacters.Text = rtrLoc
    ' Set the title-shape text font size.
    vsoCharacters.CharProps(visCharacterSize) = 8#
    ' Make the title-shape text bold.
    vsoCharacters.CharProps(visCharacterStyle) = 17#
    ' Align router text to the left

    'Make sure only one shape is selected to start.
    Set vsoSelection = ActiveWindow.Selection
    vsoSelection.Select vsoShape1, visDeselectAll + visSelect
    vsoSelection.Select vsoShape2, visSelect

    'Create a group shape.
    Set vsoGroupShape = vsoSelection.Group

    ' Drawing connectors
     Dim vConnector As Visio.Shape
     Dim vConnectorMaster As Visio.Master
     Dim vStencil As Visio.Document
     Set vStencil = Application.Documents.OpenEx("Basic Flowchart Shapes.vss", visOpenDocked)
     Set vConnectorMaster = vStencil.Masters("Dynamic Connector")
     Set vConnector = ActivePage.Drop(vConnectorMaster, 0, 0)

     Dim vsoCell1 As Visio.Cell
     Dim vsoCell2 As Visio.Cell
     Set vsoCell1 = vConnector.CellsU("BeginX")
     Set vsoCell2 = vsoShape1.CellsSRC(1, 1, 0)
     vsoCell1.GlueTo vsoCell2
     Set vsoCell1 = vConnector.CellsU("EndX")
     Set vsoCell2 = Application.ActiveWindow.Page.Shapes.ItemFromID(connectionCloud).CellsSRC(1, 1, 0)
     vsoCell1.GlueTo vsoCell2
     vConnector.CellsSRC(visSectionObject, visRowShapeLayout, visSLORouteStyle).FormulaU = "5"
     vConnector.CellsSRC(visSectionObject, visRowShapeLayout, visSLOConFixedCode).FormulaU = "0"
     vConnector.CellsSRC(visSectionObject, visRowShapeLayout, visSLOLineRouteExt).FormulaU = "2"
   
End Sub



Private Sub DrawNetworkCloud(rtrLoc As String, dblX As Double, dblY As Double)
    ' Reference: http://msdn.microsoft.com/en-us/library/ms195970.aspx
    Dim vsoShape1 As Visio.Shape
    Dim vsoShape2 As Visio.Shape
    Dim vsoMaster As Visio.Master
    Dim vsoGroupShape As Visio.Shape
    Dim vsoSelection As Visio.Selection
    ' Linking to Cisco Product Icons
    Set vsoMaster = Visio.Documents.Item("NETLOC_U.VSS").Masters.ItemU("Cloud")
    ' visRight (3) aligns name of the shape on the right
    ' Master Object Members
    Set vsoShape1 = ActivePage.Drop(vsoMaster, dblX, dblY)
    
    vsoShape1.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = dblX + 1
    vsoShape1.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = dblY - 1
    vsoShape1.CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = 2#
    vsoShape1.CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = 2#
    
    ' Reference: http://msdn.microsoft.com/en-us/library/dd483294.aspx
    Set vsoShape2 = ActivePage.DrawRectangle(dblX, dblY, dblX + 2, dblY - 2)
    vsoShape2.TextStyle = "Normal"
    vsoShape2.LineStyle = "Text Only"
    vsoShape2.FillStyle = "Text Only"
    ' Create the title-shape text.
    Dim vsoCharacters As Visio.Characters
    Set vsoCharacters = vsoShape2.Characters
    vsoCharacters.Text = rtrLoc
    ' Set the title-shape text font size.
    vsoCharacters.CharProps(visCharacterSize) = 12#
    ' Make the title-shape text bold.
    vsoCharacters.CharProps(visCharacterStyle) = 17#
    ' Text color white
    vsoCharacters.CharProps(visCharacterColor) = 0#
    'Make sure only one shape is selected to start.
    Set vsoSelection = ActiveWindow.Selection
    vsoSelection.Select vsoShape1, visDeselectAll + visSelect
    vsoSelection.Select vsoShape2, visSelect

    'Create a group shape.
    Set vsoGroupShape = vsoSelection.Group
    connectionCloud = vsoShape1.ID
    
End Sub