Generating automatic connector/cable list from Visio to Excel with VBA

[Florian]

Dear all,

At the company I'm working for, we need to make technical drawings of installations in Visio. Drawings depict devices and the cables between devices. Devices are drawn as rectangles, cables as connectors. Often the customer wants us to deliver a list of all cables. Currently we're manually editing an Excel file with all information (cable ID, cable type, input and output device ID, name, description, brand, port etc.). Also, the connector ID is typed manually in a text box in Visio next to every port of the devices. For large projects this can be a couple hundred of cables/connectors. This is a tedious and time-consuming task, especially when adjustments need to be made. So, we're looking into ways to automate things.

The current plan is to detect when a new connector is added, check the Excel table for its ID, add a new entry to Excel and place a text box near the shapes the connector is connected to (both from and to).

I already managed to detect when a connection is made, read the Excel file and make a new entry with the correct cable ID. I do this by selecting a connector master template in a stencil with a formatted name (for example 0-01-). Then I found some code in the Microsoft example files that allowed me to detect when a new shape is created. I did some String parsing on the name of the new shape and when it matches the pattern for a cable I continue. Then it looks in the Excel file for all existing cables of this type and gives the new connector a new number (if the previous highest cable ID was 0-01-005 then the new connector would be 0-01-006). The new connector gets a new entry in the Excel file. Up until now everything is working fine.

I get stuck trying to find the IDs and Names of the Shapes that the connector is connected to. I tried using

Code Select Expand

connShapeIDs = addedShape.ConnectedShapes(0, "") which throws an exception, as addedShape is one-dimensional. I can force it to be 2D:

Code Select Expand

addedShape.OneD = False but then it gets disconnected from the shapes it was originally connected from! So

Code Select Expand

connShapeIDs becomes empty.

I'm unsure on how to proceed. What can I use to find the two Shapes a connector is connecting?

Am I even on the correct approach, or how would you gurus do this?

Relevant code (with modifications):

Code Select Expand

Public Sub ShapeAdded(addedShape As Visio.Shape)


    'Custom subroutine to determine if the Shape is a valid cable that should be added
    If IsValidCable(addedShape) Then
        'This should be a connector!

        '(Omitted code that parses Excel file and adds new entry)


        'Trying the nonworking 1D forcing approach       
        addedShape.OneD = False

        Debug.Print addedShape.OneD

        Dim connShapeIDs() As Long
        Debug.Print "Attempting to get connected shape IDs"

        connShapeIDs = addedShape.ConnectedShapes(0, "")
        Debug.Print "Got connected shapes"
        'Next line prints "-1" instead of the 2 shapes the connector is clearly connected to
        Debug.Print "Amt of connected IDs: " & UBound(connShapeIDs)

        'Loop is not executed since connShapeIDs is empty
        For intCount = 0 To UBound(connShapeIDs)
            Debug.Print intCount
            Debug.Print connShapeIDs(intCount)
            Debug.Print ActivePage.Shapes(connShapeIDs(intCount)).Name
        Next
        'Connector will now lose references to which elements it is connected to:
        addedShape.OneD = True
    End If


End Sub

Cross-posted to SO: https://stackoverflow.com/questions/48381459/finding-shapes-connected-to-particular-1d-connector

[wapperdude]

See https://msdn.microsoft.com/en-us/vba/visio-vba/articles/connect-tocell-property-visio

Wapperdude

[Florian]

I found that page before but discarded it as I didn't see the benefit of cells, but it turns out they're quite important! Thank you! I have much to learn about VBA in Visio...

Updated macro for reference, I'll probably be back with more questions!

Code Select Expand

Public Sub ShapeAdded(addedShape As Visio.Shape)


    'Custom subroutine to determine if the Shape is a valid cable that should be added
    If IsValidCable(addedShape) Then
        'This should be a connector!

        '(Omitted code that parses Excel file and adds new entry)

        Dim addedConnects As Visio.Connects
        Dim vsoConnect As Visio.Connect
        Dim vsoConnectToCell As Visio.Cell
        Set addedConnects = addedShape.Connects
       
        For connCounter = 1 To addedConnects.Count
            Set vsoConnect = addedConnects(connCounter)
            Set vsoConnectToCell = vsoConnect.ToCell
            'Print connect information in the Immediate window.
            Debug.Print " To "; vsoConnectToCell.Shape.Name
           
        Next connCounter
       


End Sub

[Florian]

Next question in this topic. Having finally retrieved the correct reference to the input/output shapes, I now need to place the cable labels at the correct position relative to these shapes.

See image for an idea as to how the labels need to be placed.



So I need to retrieve the absolute coordinates (x, y, width, height) of the OUT and IN text boxes to calculate the position of the new text boxes. I've run into a lot of trouble as Visio is quite retarded in this way. Most of the time the IN and OUT text boxes will be grouped with the other shapes that belong to the device. But if you do

Code Select Expand

shapeInGroup.Cells("piny").Result("")

on a shape in a group, this will return the Y (or X) coordinate relative to its group and not the coordinates relative to the page.
I tried:         

Code Select Expand

fromShape.XYToPage fromShapeX, fromShapeY, fromShapeXActual, fromShapeYActual

but the resulting coordinates were not correct.

Some more code:

Code Select Expand


        Dim addedConnects As Visio.Connects
        Dim vsoConnect As Visio.Connect
        Set addedConnects = addedShape.Connects   'addedShape is the Connector that was added
       
        If addedConnects.Count < 2 Then
        Debug.Print "Error: invalid connection count!"
        Exit Sub
        End If
       
        Dim fromShape As Visio.Shape
        Dim toShape As Visio.Shape
       
        Set vsoConnect = addedConnects(1)   'From shape
        Set fromShape = vsoConnect.ToCell.Shape
       
        'Retrieve the coordinates in Visio interal units
       
        Dim fromShapeX As Double
        fromShapeX = fromShape.Cells("pinx").Result("")
       
        Dim fromShapeY As Double
        fromShapeY = fromShape.Cells("piny").Result("")
       
        Dim fromShapeW As Double
        fromShapeW = fromShape.Cells("width").Result("")
       
        Dim fromShapeH As Double
        fromShapeH = fromShape.Cells("height").Result("")
       
        Dim fromShapeXActual As Double
        Dim fromShapeYActual As Double
        Dim fromShapeWActual As Double
        Dim fromShapeHActual As Double
       
        'Converts from Group coordinates to absolute page coordinates
        fromShape.XYToPage fromShapeX, fromShapeY, fromShapeXActual, fromShapeYActual
       
        Debug.Print fromShapeXActual & " " & fromShapeYActual & " " & fromShapeW & " " & fromShapeH    'not correct!
       
        Const STYLE_NAME As String = "Text Only"


        Dim fromCableLabel As Visio.Shape

        'Load label shape from stencil
        Dim cableLabelMaster As Visio.Master
        Set cableLabelMaster = ActiveDocument.Masters("CableNumberLabel")
       
        'Not at correct position!
        Set fromCableLabel = ActivePage.Drop(cableLabelMaster, fromShapeXActual , fromShapeYActual )
       
   
        ' Set the LineStyle and FillStyle properties of the shape.  The Text Only
        ' style is one of the Visio default document styles.
        fromCableLabel.LineStyle = STYLE_NAME
        fromCableLabel.FillStyle = STYLE_NAME
   
        ' Set the shape text with the text passed in.
        fromCableLabel.Text = newCableID

        'Repeat for the To label (code omitted)


Suggestions? TIA.

[Florian]

Well about five minutes after my post I found a workaround: I can just add the labels to the group! Then I can easily give them coordinates relative to the IN and OUT text boxes. Looks like it's gonna work (but still a stupid workaround).

[wapperdude]

The work-around is the easiest solution. 

Some thoughts...
Don't know if you've searched the forum, but there are many, many posts related to your effort.  Here are just a few, but, by no means a complete list.

Text box labels added to connectors:
To do this, means creating a custom connector.  See links below.  Alternative would be to put the labels with the shapes, since, by construction, you know if a connection point is for an input or output signal.  This avoids making a custom dynamic connector.
http://visualsignals.typepad.co.uk/vislog/2015/04/building-a-labelled-dynamic-connector-in-visio.html
http://www.visguy.com/2014/04/24/3-label-dynamic-connector-input-methods/
http://visguy.com/vgforum/index.php?topic=5031.msg19748#msg19748
http://visguy.com/vgforum/index.php?topic=4689.msg30093#msg30093

Connection Points:
There are additional features of connection points that can be used.  Convert connection point to named connection.  This allows you to enter a "pin name" for each point, and also makes the "D-Cell" (no not a battery), available.  You can add text, e.g., "In" or "Out".  This property can be used for your labels.  Thus, shape construction can use connection point name as a "pin name" and the d-cell to label pin functionality.  See related topic: 
http://visguy.com/vgforum/index.php?topic=7543.msg31951#msg31951
http://visguy.com/vgforum/index.php?topic=7302.msg30745#msg30745
http://visguy.com/vgforum/index.php?topic=7572.0
http://visguy.com/vgforum/index.php?topic=7710.0

Schematic capture scheme:
Concept with working implementation.  Perhaps provides some ideas...http://visguy.com/vgforum/index.php?topic=6314.msg25934#msg25934

Pushing data into subshapes:  http://visguy.com/vgforum/index.php?topic=6318.0

Hope these entries help, provide genesis for new solutions.
Wapperdude

[Florian]

So I've got the basis pretty much worked out! It's working quite nicely (but still requires many upgrades)

One thing I'm struggling with now is: all my VBA code is in a stencil. This is so the macros can move between different projects easily. But I haven't found a way to easily trigger the macros from a document.

Is there an easy way to call a specific subroutine from a stencil? My idea is to add something to the stencil, drop it in the main document and make it run the initialising subroutine when it's clicked.

I tried to save an ActiveX button in the stencil but upon dropping it into the main document, I got the error that there are already too many shapes on the page (apparently an ActiveX button can't have an ID higher than 1024, what is this, 1998???). I then tried to add a macro to the EventDblClick Cell of a Shape but double clicking the shape resulted in a System Error. Maybe my syntax is wrong? What would be the syntax to call a subroutine in a certain module in a certain stencil? Can't find an unambiguous answer online...

[Florian]

Found answer here: http://visguy.com/vgforum/index.php?topic=359.msg1640#msg1640