Hi Guys,
There were a number of problems with the code. As the article stated, the code was written in VB.NET, so a few changes need to be made:
- A lot of spacing problems were messing up the line continuations. Ie: where " _" occurs at the end of a line
- The "Set" keyword was missing from object assignments
The last problem was specific to oompa_l's situation. He had turned off connector-gluing at the top-level, so the actual code needed to glue the connectors to sub-shapes of his circles. I did this by identifying instances of "Master.0" (his particular shape)
If a shape is an instance of Master.0, then we get the first sub-shape instead, and glue the connector to that. This is a hack-fix, and won't handle modifications to shapes very well. But, well, I get paid the big bucks for that kind of stuff.
Here's the interesting code, inside of Sub m_connectShapes:
Private Sub m_connectShapes(ByRef shpFrom As Visio.Shape, ByRef shpTo As Visio.Shape)
...
'// Check for oompa_l special case:
If Not (shpFrom.Master Is Nothing) Then
If shpFrom.Master.Name = "Master.0" Then
'// Connect its Begin to a sub-shape 'From' shape:
Call shpConn.CellsU("BeginX").GlueTo(shpFrom.Shapes(1).CellsU("PinX"))
End If
Else
'// Connect its Begin to the 'From' shape:
Call shpConn.CellsU("BeginX").GlueTo(shpFrom.CellsU("PinX"))
End If
If Not (shpTo.Master Is Nothing) Then
If shpTo.Master.Name = "Master.0" Then
'// Connect its End to a sub-shape 'From' shape:
Call shpConn.CellsU("EndX").GlueTo(shpTo.Shapes(1).CellsU("PinX"))
End If
Else
'// Connect its End to the 'To' shape:
Call shpConn.CellsU("EndX").GlueTo(shpTo.CellsU("PinX"))
End If
End Sub
You can see, I just repeated the "fix" code twice in the If-Then-Else clauses. This is kind of sloppy, and if oompa_l will be making lots of changes, this needs to be compartmentalized and more robust.
Here's the whole updated listing:
Public Sub ConnectAllShapes()
On Error GoTo Err
'// Create an undo-scope, so that we can undo all the
'// connections with just one Ctrl + Z:
Dim UndoID As Long
UndoID = Visio.Application.BeginUndoScope("Connect All Shapes to Each Other")
'// This is where we really get the connecting done:
'// Get a Visio Page object:
Dim pg As Visio.Page
Set pg = Visio.ActivePage
'// Connect all shapes on the page:
Call m_ConnectAllShapes(pg)
Call Visio.Application.EndUndoScope(UndoID, True)
Exit Sub
Err:
Debug.Print "An error occurred! " & vbCrLf & Error$
Call Visio.Application.EndUndoScope(UndoID, False)
End Sub
Private Sub m_ConnectAllShapes(ByRef visPg As Visio.Page)
Dim shpFrom As Visio.Shape, shpTo As Visio.Shape, shpConn As Visio.Shape, shp As Visio.Shape
Dim collShapes As Collection
Dim i As Integer, j As Integer
'// Set the page-layout settings for routing-style,
'// jump-style, etc.
Call m_setPageLayoutSettings(visPg)
'// Add all the non-connector shapes to a VB collection:
Set collShapes = m_getShapesToConnect(visPg)
'// Loop through the shapes in the shapes collection:
For i = 1 To collShapes.Count
Set shpFrom = collShapes.Item(i)
'// Connect to all the other shapes:
For j = i + 1 To collShapes.Count
Set shpTo = collShapes.Item(j)
Call m_connectShapes(shpFrom, shpTo)
Next j
Next i
End Sub
Private Sub m_connectShapes(ByRef shpFrom As Visio.Shape, ByRef shpTo As Visio.Shape)
'// Visio 2007 introduced a new method for connection
'// shapes. This proc looks at the Visio version and
'// decides whether to use the old way or the new way.
Dim pg As Visio.Page
Set pg = shpFrom.ContainingPage
'// Note: if you're not running Visio 2007, this might not
'// even compile -- you'll have to comment-out the first part
'// of the If-Then block...
'// Drop the built-in connector object somewhere on the page:
Set shpConn = pg.Drop(pg.Application.ConnectorToolDataObject, 0, 0)
'// Check for oompa_l special case:
If Not (shpFrom.Master Is Nothing) Then
If shpFrom.Master.Name = "Master.0" Then
'// Connect its Begin to a sub-shape 'From' shape:
Call shpConn.CellsU("BeginX").GlueTo(shpFrom.Shapes(1).CellsU("PinX"))
End If
Else
'// Connect its Begin to the 'From' shape:
Call shpConn.CellsU("BeginX").GlueTo(shpFrom.CellsU("PinX"))
End If
If Not (shpTo.Master Is Nothing) Then
If shpTo.Master.Name = "Master.0" Then
'// Connect its End to a sub-shape 'From' shape:
Call shpConn.CellsU("EndX").GlueTo(shpTo.Shapes(1).CellsU("PinX"))
End If
Else
'// Connect its End to the 'To' shape:
Call shpConn.CellsU("EndX").GlueTo(shpTo.CellsU("PinX"))
End If
End Sub
Private Function m_getShapesToConnect(ByRef visPg As Visio.Page) As Collection
Dim shp As Visio.Shape
Dim collShapes As Collection
Set collShapes = New Collection
'// For this example, we will get all shapes on the page
'// that ARE NOT of these:
'//
'// 1. Connectors
'// 2. Foreign objects (like Buttons)
'// 3. Guides
For Each shp In visPg.Shapes
If (shp.OneD = False) And _
(shp.Type <> Visio.VisShapeTypes.visTypeForeignObject) And _
(shp.Type <> Visio.VisShapeTypes.visTypeGuide) Then
Call collShapes.Add(shp)
End If
Next
Set m_getShapesToConnect = collShapes
End Function
Private Sub m_setPageLayoutSettings(ByRef visPg As Visio.Page)
'// We can set layout and routing options for the page by
'// accessing the ShapeSheet for the page, and setting cells
'// in the Page Layout section.
'//
'// You can see the PageSheet by deselecting all shapes on the
'// page, and choosing Window > Show ShapeSheet.
'// Set page routing style to center-to-center:
visPg.PageSheet.CellsSRC(Visio.VisSectionIndices.visSectionObject, _
Visio.VisRowIndices.visRowPageLayout, _
visPLORouteStyle).ResultIUForce = 16
'// Set to connector intersection to 'gap':
visPg.PageSheet.CellsSRC(Visio.VisSectionIndices.visSectionObject, _
Visio.VisRowIndices.visRowPageLayout, _
Visio.VisCellIndices.visPLOJumpStyle).ResultIUForce = 2
'// Note: another way to access the PageSheet cells is by name, ie:
'// visPg.PageSheet.Cells("RouteStyle").ResultIU = 16
'// visPg.PageSheet.Cells("LineJumpStyle").ResultIU = 2
End Sub
