VBA Autoconnect function

[8l.c.r.m7]

Hello,
I have problems with autoconnecting shapes (routers) with connectors.

Application.ActivePage.Shapes(j).AutoConnect Application.ActivePage.Shapes(i), visAutoConnectDirNone, vsoConnectorShape

It works great until there are redundant connectors between same nodes - then it makes connector fully overlapping. Do you know any workaround to make all links visible?

I tried moving nodes first (depending on how many links there are) so there should be other shortest path each time. However if I move them they still connects the same way - therefor position of nodes (shapes/routers) is not a factor.

Thanks for help!

[Visio Guy]

There are settings for "separate all" and "overlap none" buried in Page Setup > Layout, but it doesn't always work. If there are connection points on shapes, connectors will gravitate towards them.

[8l.c.r.m7]

Its still the same.  I set separate: all, overlap: none ... it autoconnects via vba the same way.

[Visio Guy]

I believe it. There is a way to get separated connectors, but it seems inconsistent, and I'm not sure if it works with AutoConnect in code.

[wapperdude]

I rarely found consistent behavior with dynamic connector routing, regardless of the settings.

I suspect you have to grab one of the connectors after it's been glued and move it.  The code would look something like the following.  Note, the two shapes were set with same vertical elevation, but separated horizontally.  So, the connector was merely being move down, in this case.  The 1st glue line moves one end, the 2nd moves the other so that the connector remained a horizontal straight line.  Not sure how to guarantee that last point, since the positioning of the connector ends is relative to the shape to which they are attached.

It might be easier to have specific connection points on each shape and glue the connector to points of choice. 

Another thought, might be to move each point by a fixed amount...

None of these possibilities sounds particularly attractive.

Code Select Expand

Sub MyMac()

    Dim vsoCell1 As Visio.Cell
    Dim vsoCell2 As Visio.Cell
    Set vsoCell1 = Application.ActiveWindow.Page.Shapes.ItemFromID(4).CellsU("EndX")
    vsoCell1.GlueToPos Application.ActiveWindow.Page.Shapes.ItemFromID(1), 1#, 0.2
   
    Set vsoCell1 = Application.ActiveWindow.Page.Shapes.ItemFromID(4).CellsU("BeginX")
    vsoCell1.GlueToPos Application.ActiveWindow.Page.Shapes.ItemFromID(2), 0#, 0.272727

End Sub




Hopefully, this helps you with a work-around.

Wapperdude