VBA - Connecting two Connection Points by Name

[afg123]

I have shapes with named connection points. I'd like to dynamically connect specific connection points on these shapes.

For example if Shape1 and Shape2 both have connection points named: "A1, A2, B1, B2" on their respective ShapeSheets, I might want to connect point A1 on Shape1 to point B2 and Shape2.

I'm looking at some example code provided with the visio SDK that seems to drop a connector on the page, and then glues its ends between two target shapes such that if one shape is moved, the connector latches onto different connection points on the shape to make the diagram more visually simple- that's not what I want unfortunately, but it's close-ish. I've included that function for reference.

Do you have any suggestions or other resources to help me out?

Code Select Expand

        '// <summary>This procedure drops a Dynamic connector master on
        '// the page, then connects the shapes by gluing the Dynamic
        '// connector to the PinX values of the 2-D shapes to create
        '// dynamic glue.</summary>
        '// <param name="shapeFrom">Shape where the Dynamic connector begins
        '// </param>
        '// <param name="shapeTo">Shape where the Dynamic connector ends
        '//</param>
        Private Shared Sub connectWithDynamicGlueAndConnector( _
            ByVal shapeFrom As Microsoft.Office.Interop.Visio.Shape, _
            ByVal shapeTo As Microsoft.Office.Interop.Visio.Shape)

            Dim cellBeginX As Cell
            Dim cellEndX As Cell
            Dim connector As Microsoft.Office.Interop.Visio.Shape

            ' Add a Dynamic connector to the page.
            connector = dropMasterOnPage( _
                shapeFrom.ContainingPage, _
                "Dynamic Connector", _
                FlowchartStencil, _
                0.0, _
                0.0)

            ' Connect the begin point.
            cellBeginX = connector.CellsSRC( _
                CShort(VisSectionIndices.visSectionObject), _
                CShort(VisRowIndices.visRowXForm1D), _
                CShort(VisCellIndices.vis1DBeginX))

            cellBeginX.GlueTo(shapeFrom.CellsSRC( _
                CShort(VisSectionIndices.visSectionObject), _
                CShort(VisRowIndices.visRowXFormOut), _
                CShort(VisCellIndices.visXFormPinX)))

            ' Connect the end point.
            cellEndX = connector.CellsSRC( _
                CShort(VisSectionIndices.visSectionObject), _
                CShort(VisRowIndices.visRowXForm1D), _
                CShort(VisCellIndices.vis1DEndX))

            cellEndX.GlueTo(shapeTo.CellsSRC( _
                CShort(VisSectionIndices.visSectionObject), _
                CShort(VisRowIndices.visRowXFormOut), _
                CShort(VisCellIndices.visXFormPinX)))

        End Sub

[UnifiedCloud]

Did you ever find a solution for this? I have a similar issue.

[wapperdude]

See https://learn.microsoft.com/en-us/office/vba/api/Visio.Cell.GlueTo

Below code shows several different syntaxes:
1) GlueToPos
2) GlueTo (with and without using named Connection Pt)
3} using walking glue method => specifies shape, but allows connection to freely walk about

Shapes, Sheet.1 and .2 are 2D shapes
Shapes, Sheet.3 and .4 are connector shapes

vsoCell1 is Beginning cell for connector
vsoCell3 is Ending cell for connector

Code Select Expand


Sub GlueMethods()

    Dim vsoCell1 As Visio.Cell
    Dim vsoCell2 As Visio.Cell
   
'With some connector...
    Set vsoCell1 = ActiveWindow.Page.Shapes.ItemFromID(3).CellsU("BeginX")
    vsoCell1.GlueToPos ActiveWindow.Page.Shapes.ItemFromID(1), 1#, 0.75     'referrence by position on a shape, no conx pt
   
    Dim vsoCell3 As Visio.Cell
    Dim vsoCell4 As Visio.Cell
     
   Set vsoCell3 = ActiveWindow.Page.Shapes.ItemFromID(3).CellsU("EndX")

'Next 2 lines are example, valid methods, but choose one or the other
'    Set vsoCell4 = ActiveWindow.Page.Shapes.ItemFromID(2).CellsSRC(7, 0, 0)
    Set vsoCell4 = ActiveWindow.Page.Shapes.ItemFromID(2).CellsU("Connections.Pt1")
    vsoCell3.GlueTo vsoCell4
   
'With another connector...
    Set vsoCell1 = ActiveWindow.Page.Shapes.ItemFromID(4).CellsU("BeginX")
    Set vsoCell2 = ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(1, 1, 0) 'Walking Glue
    vsoCell1.GlueTo vsoCell2
   
    Set vsoCell3 = ActiveWindow.Page.Shapes.ItemFromID(4).CellsU("EndX")

'Again, choose one or the other.
'    Set vsoCell4 = ActiveWindow.Page.Shapes.ItemFromID(2).CellsU("Connections.Pt2")
    Set vsoCell4 = ActiveWindow.Page.Shapes.ItemFromID(2).CellsSRC(7, 1, 0)  'Reference by row number
'    Debug.Print vsoCell3.Name
'    Debug.Print vsoCell4.Name
    vsoCell3.GlueTo vsoCell4

End Sub
 

[UnifiedCloud]

Thank you. When I reread the original code, it made more sense. i was able to get a very similar approach to work. I appreciate you sharing other approaches.

[UnifiedCloud]

Wrapperdude, thanks for the walking glue method! I will have to try that one as well. I used a named connection point, but can see where walking glue would work just as well, maybe better. Awesome share, thanks!