Visio Guy

Hi!
I am trying to do the simplest thing - connect two 2d shapes in code with GlueTo.
I have dropped two shapes, added to them connection points with "In" and "Out". Now when I am trying to connect them with a mouse - it`s all ok.
Then I have written a macro:
Sub Macro5()

    'Enable diagram services
    Dim DiagramServices As Integer
    DiagramServices = ActiveDocument.DiagramServicesEnabled
    ActiveDocument.DiagramServicesEnabled = visServiceVersion140

    Dim UndoScopeID1 As Long
    UndoScopeID1 = Application.BeginUndoScope("1")
    ActiveWindow.DeselectAll
    ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(1), visSelect
    Application.ActiveWindow.Selection.Move -1.161417, 0.669291
    Dim vsoCell1 As Visio.Cell
    Dim vsoCell2 As Visio.Cell
    Set vsoCell1 = Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsU("PinX")
    Set vsoCell2 = Application.ActiveWindow.Page.Shapes.ItemFromID(15).CellsSRC(7, 0, 0)
    vsoCell1.GlueTo vsoCell2
    Dim vsoCell3 As Cell
    Dim vsoCell4 As Cell
    Set vsoCell3 = Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionConnectionPts, 0, 0)
    Set vsoCell4 = Application.ActiveWindow.Page.Shapes.ItemFromID(15).CellsSRC(visSectionConnectionPts, 0, 0)
    vsoCell3.GlueTo vsoCell4
    Application.EndUndoScope UndoScopeID1, True

    'Restore diagram services
    ActiveDocument.DiagramServicesEnabled = DiagramServices

End Sub

And it is not working... When I manually unglued shapes it throws "Inappropriate source object for this action" - but it`s macro!
Can you help me to write correct code?

Can someone help me?
Maybe any additional details needed?

It will work if add control handle and glue it, not PinX

can you clarify the 'control handle' and pinx comment?  i am having this same exact issue

got it.  see below for others with same question.


Public Sub GlueTwoD_Example()

    Dim sBoxLower As Visio.Shape ' lower box
    Dim sBoxCaption As Visio.Shape  ' upper caption box
    Dim vsoCellGlueFromObject As Visio.Cell
    Dim vsoCellGlueToObject As Visio.Cell
   
   
   
    Dim vsoCharacters1 As Visio.Characters    ' this is for adding text to the box
   
    'Draw the lower rectangle.
    Set sBoxLower = ActivePage.DrawRectangle(1, 1, 4, 2)
    sBoxLower.AddSection visSectionConnectionPts
    sBoxLower.AddRow visSectionConnectionPts, visRowLast, visTagDefault
    sBoxLower.CellsSRC(visSectionConnectionPts, 0, visCnnctX).FormulaForceU = "Width*1"
    sBoxLower.CellsSRC(visSectionConnectionPts, 0, visCnnctY).FormulaForceU = "Height*1"
    sBoxLower.CellsSRC(visSectionConnectionPts, 0, visCnnctDirX).FormulaForceU = "0 in"
    sBoxLower.CellsSRC(visSectionConnectionPts, 0, visCnnctDirY).FormulaForceU = "0 in"
    sBoxLower.CellsSRC(visSectionConnectionPts, 0, visCnnctType).FormulaForceU = "2"
    sBoxLower.CellsSRC(visSectionConnectionPts, 0, visCnnctAutoGen).FormulaForceU = "0 in"
    sBoxLower.CellsSRC(visSectionConnectionPts, 0, 6).FormulaForceU = ""
   


    'Draw the caption rectangle.
    Set sBoxCaption = ActivePage.DrawRectangle(5, 5, 5.3, 5.4)   
    sBoxCaption.AddSection visSectionConnectionPts
    sBoxCaption.AddRow visSectionConnectionPts, visRowLast, visTagDefault
    sBoxCaption.CellsSRC(visSectionConnectionPts, 0, visCnnctX).FormulaForceU = "Width*0"
    sBoxCaption.CellsSRC(visSectionConnectionPts, 0, visCnnctY).FormulaForceU = "Height*0"
    sBoxCaption.CellsSRC(visSectionConnectionPts, 0, visCnnctDirX).FormulaForceU = "0 in"
    sBoxCaption.CellsSRC(visSectionConnectionPts, 0, visCnnctDirY).FormulaForceU = "0 in"
    sBoxCaption.CellsSRC(visSectionConnectionPts, 0, visCnnctType).FormulaForceU = "2"  ' not 2 is required
    sBoxCaption.CellsSRC(visSectionConnectionPts, 0, visCnnctAutoGen).FormulaForceU = "0 in"
    sBoxCaption.CellsSRC(visSectionConnectionPts, 0, 6).FormulaForceU = ""


   'add text to captions box (upper box)
    Set vsoCharacters1 = sBoxCaption.Characters
    vsoCharacters1.Begin = 0
    vsoCharacters1.End = 0
    vsoCharacters1.text = "20%" & Chr(10) & "Text here"
   


    'Get the Cell objects needed to make the connections.  - the FROM object / line
    Set vsoCellGlueFromObject = sBoxCaption.CellsSRC(visSectionConnectionPts, 0, 0)
   
    'Get the Cell objects needed to make the connections.  - the TO object / Box
      Set vsoCellGlueToObject = sBoxLower.CellsSRC(visSectionConnectionPts, 0, 0)   ' UR corner of lower rectangle

    'Use the GlueTo method to glue the begin point of the line to the top right vertex (Geometry1.X3) of the lower 2-D shape.
    vsoCellGlueFromObject.GlueTo vsoCellGlueToObject       'debug this

End Sub