Using Excel VBA to connect two shapes

Started by matthew, November 18, 2021, 05:52:18 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

matthew

HI, I'm having difficulty in connecting 2 objects together in Visio using Excel vba.
I can create the objects but when it comes to adding the link between them I can't get it to work, tried everything I could read but still not working.  I'm trying to connect from the left (connections.E) of one object to the right (connections.W).
The code drops a connector but won't link it to an object, Can someone point me in the right direction please?  Also how do I  make the connector a straight line using excel vba?
Here is the code to draw the link, hopefully someone will see something, (everything is declared earlier in the app)...............

Dim cptL, cptR As String
cptL = "Connections.E"
cptR = "Connections.W"
For x = 2 To UBound(link2array)
    AppVisio.ActiveWindow.Page.Drop AppVisio.Documents.item(1).Masters.ItemU("Dynamic Connector"), 0#, 0#
    Set vsoshape = AppVisio.ActiveWindow.Selection(1)
    shpid = vsoshape.ID

    'attach the connector
    UndoScopeID10 = AppVisio.BeginUndoScope("Size Object")
    Set vsoCell1 = AppVisio.ActiveWindow.Page.Shapes.ItemFromID(shpid).Cells("BeginX")     'this is the start of the connector
    Set vsoCell2 = AppVisio.ActiveWindow.Page.Shapes.ItemFromID(link2array(x, 2)).CellsSRC(visSectionConnectionPts, 0, 0)  'tried .Connections.E   and .Cells(cptL) but value of vsocell2 is always 0!
    Debug.Print "vsocell2=" & vsoCell2
    vsoCell1.GlueTo vsoCell2
    AppVisio.EndUndoScope UndoScopeID10, True
   
    'attach the connector to the other object
    UndoScopeID20 = AppVisio.BeginUndoScope("Size Object")
    Set vsoCell3 = AppVisio.ActiveWindow.Page.Shapes.ItemFromID(shpid).CellsU("EndX")   'this is the point of the connector
    Set vsoCell4 = AppVisio.ActiveWindow.Page.Shapes.ItemFromID(link2array(x, 2)).CellsSRC(visSectionConnectionPts, 1, 0)    '.Cells(cptR)
    Debug.Print "vsocell4=" & vsoCell4
    vsoCell3.GlueTo vsoCell4
    AppVisio.EndUndoScope UndoScopeID20, True
Next x

thanks for taking a look, it is driving me mad!
kind regards
Matthew

matthew

Thanks for reviewing this post, I managed to get it working using the code below which may be of use
kind regards
Matthew

For x = 2 To UBound(link1array)
    'make connection points
    shaperef = link1array(x, 2)
    Call addconnections(shaperef)
    shaperef = link1array(x, 3)
    Call addconnections(shaperef)
   
    Set vsoshape = AppVisio.ActivePage.Shapes("Sheet." & link1array(x, 2))  '.Cells(cptL)
    Set vsoshape2 = AppVisio.ActivePage.Shapes("Sheet." & link1array(x, 3)) '.Cells(cptR)
    ' drop it somewhere
    Set myconnector = AppVisio.ActiveWindow.Page.Drop(AppVisio.ConnectorToolDataObject, 1, 10)
    ' connect it to the nearest connection point of a shape (varies if you drag)
    myconnector.Cells("BeginX").GlueTo vsoshape.CellsSRC(visSectionConnectionPts, 0, 0) 'Cells(cptL)
    ' connect it a fixed connection point (example if shape has 4 points)
    myconnector.Cells("EndX").GlueTo vsoshape2.CellsSRC(visSectionConnectionPts, 1, 0)    '.Cells(cptR)
    'connect link1array(x,2) to link1array(x,3)
    'vsoshape.AutoConnect vsoshape2, visAutoConnectDirNone, vsoconnectorshape
    'get link ID
    shpid = myconnector.ID
    link1array(x, 4) = shpid
    'straighten connector
    UndoScopeID1 = AppVisio.BeginUndoScope("Straight Connector")
    AppVisio.ActiveWindow.Page.Shapes.ItemFromID(shpid).CellsSRC(visSectionObject, visRowShapeLayout, visSLOLineRouteExt).FormulaU = "1"
    AppVisio.ActiveWindow.Page.Shapes.ItemFromID(shpid).CellsSRC(visSectionObject, visRowShapeLayout, visSLORouteStyle).FormulaU = "16"
    AppVisio.EndUndoScope UndoScopeID1, True
    'format link
    'Call t1linkformat(x)
Next x