Connectivity Reporting

[wapperdude]

Decided to see if there was a simpler way to find connectivity using custom code.  Yes... and no.
The code below is much simpler than previous versions, but, it doesn't always get the directionality correct.  Specifically, when a connector is glued to another connector, there can be misinformation.  But, on the other hand, it does seem to catch all of the connections.  Even those that are floating or only have one end connected.

So, for what it's worth, here's the code:  (note, output is immediate window, debug.print)

Code Select Expand


Public Sub GetGluedShapes()
'Use Shape.GluedShapes to get the shapes that are glued to a shape
    Dim shp As Visio.Shape
    Dim shpIDs() As Long
    Dim i As Integer

    Debug.Print "GluedShapes"
    For Each shp In ActivePage.Shapes
        If shp.OneD Then
            Debug.Print shp.Name
       
        shpIDs = shp.GluedShapes(visGluedShapesIncoming1D, "")
        For i = 0 To UBound(shpIDs)
            Debug.Print "Incoming 1D shapes"
            Debug.Print ActivePage.Shapes.ItemFromID(shpIDs(i)).Name
        Next
   
        shpIDs = shp.GluedShapes(visGluedShapesOutgoing1D, "")
        For i = 0 To UBound(shpIDs)
            Debug.Print "Outgoing 1D shapes"
            Debug.Print ActivePage.Shapes.ItemFromID(shpIDs(i)).Name
        Next
   
        shpIDs = shp.GluedShapes(visGluedShapesIncoming2D, "")
        For i = 0 To UBound(shpIDs)
            Debug.Print "Incoming 2D shapes"
            Debug.Print ActivePage.Shapes.ItemFromID(shpIDs(i)).Name
        Next
   
        shpIDs = shp.GluedShapes(visGluedShapesOutgoing2D, "")
        For i = 0 To UBound(shpIDs)
            Debug.Print "Outgoing 2D shapes"
            Debug.Print ActivePage.Shapes.ItemFromID(shpIDs(i)).Name
        Next
        End If
        Debug.Print ""
    Next
End Sub


[wapperdude]

Updated file/code.

[wapperdude]

Based upon another, recent post, I realized that this post needed an update.  I believe that there is even a more simpler coding solution...the simplest solution if you will.

This is for all shapes on a page and doesn't require, but will work with Connection points with named rows.  That is, it refers to the shapes and not their literal connections.  The code:

Code Select Expand


Public Sub NotNamedRowListGluedConnections()
'Code 1st lists connector, then shows, if any, incoming and outgoing shapes
'
    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
    Dim vCon As Connect
    Dim typeSkip As Boolean
   
    typeSkip = False
   
    For Each shp In Visio.ActivePage.Shapes
        If shp.OneD Then
            For Each vCon In shp.Connects
                If Not typeSkip Then
                    Debug.Print "Connector:"; shp.Name
                    Debug.Print "Source End:", vCon.ToSheet.Name
                    typeSkip = True
                Else
                    If shp.Connects.Count < 2 Then
           `             Debug.Print "Connector", shp.Name
                    End If
                    Debug.Print "Receive End:", vCon.ToSheet.Name
                    typeSkip = False
                End If
            Next
        Debug.Print ""
        End If
    Next
End Sub


[wapperdude]

Here's "simplest" version that catches named row in either the incoming/outgoing 2D shape attached to the connector.

Code Select Expand


Public Sub NamedRowListGluedConnections()
'Code 1st lists connector, then shows, if any, incoming and outgoing shapes
'
    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
    Dim vCon As Connect
    Dim typeSkip As Boolean
   
    typeSkip = False
   
    For Each shp In Visio.ActivePage.Shapes
        If shp.OneD Then
            For Each vCon In shp.Connects
                If Not typeSkip Then
                    Debug.Print "Connector:  "; shp.Name, shp.Text 'vCon.FromSheet, vCon.FromSheet.Text
                    Debug.Print "Source shape:  ", vCon.ToSheet.Name, vCon.ToCell.RowName
                    typeSkip = True
                Else
                    If shp.Connects.Count < 2 Then
                        Debug.Print "Connector:  ", shp.Name, shp.Text
                    End If
                    Debug.Print "Receive shape:  ", vCon.ToSheet.Name, vCon.ToCell.RowName; ""
                    typeSkip = False
                End If
            Next
        Debug.Print ""
        End If
    Next
End Sub