Visio 2013 Visual Basic for Applications

VisioMVP
VisioGuy

Visio 2013 Automation reference
Application.ActiveWindow
Window
Shape
Selection

Public Sub AddConnectionPoint()
    Dim selectedShapes  As Selection
    Dim theShape        As Shape
    Dim index           As Integer
    Dim rowNumber       As Integer
    
    Set selectedShapes = ActiveWindow.Selection
    
    For index = 1 To selectedShapes.Count
        Set theShape = selectedShapes.Item(index)
        
        ' If there is no 'Connection Points' section, create one for the shape
        If theShape.SectionExists(Visio.visSectionConnectionPts, 1) = False Then
            theShape.AddSection (Visio.visSectionConnectionPts)
        End If
        
        ' Add a new row to the 'Connection Points' section
        rowNumber = theShape.AddRow(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.VisRowTags.visTagCnnctPt)
        theShape.CellsSRC(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.visX).Formula = "=0"
        theShape.CellsSRC(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.visY).Formula = "=Height/2"
        
        rowNumber = theShape.AddRow(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.VisRowTags.visTagCnnctPt)
        theShape.CellsSRC(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.visX).Formula = "=Width/2"
        theShape.CellsSRC(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.visY).Formula = "=0"
        
        rowNumber = theShape.AddRow(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.VisRowTags.visTagCnnctPt)
        theShape.CellsSRC(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.visX).Formula = "=Width"
        theShape.CellsSRC(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.visY).Formula = "=Height/2"
        
        rowNumber = theShape.AddRow(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.VisRowTags.visTagCnnctPt)
        theShape.CellsSRC(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.visX).Formula = "=Width/2"
        theShape.CellsSRC(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.visY).Formula = "=Height"
        
        rowNumber = theShape.AddRow(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.VisRowTags.visTagCnnctPt)
        theShape.CellsSRC(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.visX).Formula = "=(Width/2)  * (1 + cos(45 deg))"
        theShape.CellsSRC(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.visY).Formula = "=(Height/2) * (1 + cos(45 deg))"
        
        rowNumber = theShape.AddRow(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.VisRowTags.visTagCnnctPt)
        theShape.CellsSRC(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.visX).Formula = "=(Width/2)  * (1 - cos(45 deg))"
        theShape.CellsSRC(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.visY).Formula = "=(Height/2) * (1 + cos(45 deg))"
        
        rowNumber = theShape.AddRow(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.VisRowTags.visTagCnnctPt)
        theShape.CellsSRC(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.visX).Formula = "=(Width/2)  * (1 + cos(45 deg))"
        theShape.CellsSRC(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.visY).Formula = "=(Height/2) * (1 - cos(45 deg))"
        
        rowNumber = theShape.AddRow(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.VisRowTags.visTagCnnctPt)
        theShape.CellsSRC(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.visX).Formula = "=(Width/2)  * (1 - cos(45 deg))"
        theShape.CellsSRC(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.visY).Formula = "=(Height/2) * (1 - cos(45 deg))"
        
    Next
End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *