Stretch Smart Shape & automatically add connection points [SOLVED]

Started by The Walrus, October 16, 2017, 07:08:17 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

The Walrus

Thanks for the feedback.  I'm still seeing the same behavior, though.

intI = 0
    shpHgt = 0
    shpHgt = vsoShape.Cells("Height").ResultIU
    If shpHgt >= 0.5 Then
            intI = (shpHgt - 0.25) / 0.125           'Sets number of needed connection points based on geometry of shape
    End If


If I put a breakpoint at the shpHgt = vsoShape.Cells("Height").ResultIU line, it shows intI and shpHgt as both = 0, and .ResultIU returns the correct value.

However a breakpoint at the beginning of the If statement returns shpHgt = 1, and a breakpoint at End If shows intI = 6.

Both variables are Long at this point.  So confused!
I use Visio 2013 Pro at work and 2016 Pro at home

The Walrus

Based on this MSDN link, I changed the shpHgt variable to Double, and now both it and the intI are working.  How odd that changing the type of one variable affects the performance of another.
I use Visio 2013 Pro at work and 2016 Pro at home

The Walrus

I got it working!!!!

Sorry for the multiple posts today.

Here's my 'completed' code.  I'm sure I can optimize it further.

Sub AddConnPts()

    Dim I As Integer            'Incrementer
    Dim N As Integer            'Number of Connection Points Needed
    Dim C As Integer            'Number of existing Connection Points
    Dim H As Double             'Height of Shape
    Dim intRowIndex1 As Integer 'Row Incrementer
    Dim WString As String       'String to put in Connect points X Column
    Dim HString As String       'String to put in Connect points Y Column
    Dim vsoShape As Visio.Shape
    Dim vsoRow1 As Visio.Row
   
    If ActiveWindow.Selection.Count <> 1 Then
        MsgBox "This macro works with exactly ONE shape. Please select one and run again.", vbOK
        Exit Sub
    End If
   
    Set vsoShape = ActiveWindow.Selection(1)
    H = vsoShape.Cells("Height").ResultIU
   
    If H >= 0.5 Then
            N = ((H - 0.25) / 0.125)    'Sets number of needed connection points based on geometry of shape
       
            'Get Existing Connection Points = C
            C = ActiveWindow.Selection(1).RowCount(Visio.visSectionConnectionPts)
           
            'Loop through all the rows
            For intRowIndex1 = 0 To C - 1
            Next intRowIndex1
           
                If C < N Then
                    For I = C + 1 To N
           
                    intRowIndex1 = ActiveWindow.Selection(1).AddRow(visSectionConnectionPts, visRowLast, visTagCnnctPt)
                    WString = "Width*1"
                    HString = "IF(Height*1> 0.4375 + 0.125*" & intRowIndex1 - 1 & " ,Height*1-(0.125*" & I & "),0)"
                   
                    Set vsoRow1 = ActiveWindow.Selection(1).Section(visSectionConnectionPts).Row(intRowIndex1)
                    vsoRow1.Cell(visCnnctX).FormulaU = WString
                    vsoRow1.Cell(visCnnctY).FormulaU = HString
                    vsoRow1.Cell(visCnnctDirX).FormulaU = -1#
                    vsoRow1.Cell(visCnnctDirY).FormulaU = 0#
                    vsoRow1.Cell(visCnnctType).FormulaU = visCnnctTypeInward
           
                    Next I
                End If
        End If
   
End Sub
I use Visio 2013 Pro at work and 2016 Pro at home

The Walrus

I've played with it a bit more and have a final solution that works with all of my desired connector shapes.  I've attached a VSD file with them, and the 'final' code below.  I'll edit the thread also to indicate that this issue is solved. Thanks for all the help!

Sub AddConnPts()

    Dim I As Integer            'Incrementer
    Dim N As Integer            'Number of Connection Points Needed
    Dim C As Integer            'Number of existing Connection Points
    Dim H As Double             'Height of Shape
    Dim G As Double             'Geometry constant from Scratch section
    Dim intRowIndex1 As Integer 'Row Incrementer
    Dim WString As String       'String to put in Connect points X Column
    Dim HString As String       'String to put in Connect points Y Column
    Dim vsoShape As Visio.Shape
    Dim vsoRow1 As Visio.Row
   
    If ActiveWindow.Selection.Count <> 1 Then
        MsgBox "This macro works with exactly ONE shape. Please select one and run again.", vbOK
        Exit Sub
    End If
   
    Set vsoShape = ActiveWindow.Selection(1)
    H = vsoShape.Cells("Height").ResultIU
    G = vsoShape.Cells("Scratch.Y1").ResultIU
       
    'Check to see if the shape hieght meets miminum for two connection points
    If H >= G Then
       
        'Sets number of needed connection points based on geometry of shape
        'Subtract G from the total height
        'G is 4.5 grid spaces (0.0625) for Broken Connector
        'G is 2.5 grid spaces (0.0625) for Whole Connector
        G = vsoShape.Cells("Scratch.A1").ResultIU
        N = ((H - G * 0.0625) / 0.125)
       
        'Get Existing Connection Points = C
        C = ActiveWindow.Selection(1).RowCount(Visio.visSectionConnectionPts)
           
        'Loop through all the rows
        For intRowIndex1 = 0 To C - 1
        Next intRowIndex1
           
            If C < N Then
                For I = C + 1 To N
           
                intRowIndex1 = ActiveWindow.Selection(1).AddRow(visSectionConnectionPts, visRowLast, visTagCnnctPt)
                WString = "Width*1"
               
                'Used for the Height Dimension of the connector to place the connection points
                G = vsoShape.Cells("Scratch.X1").ResultIU
                HString = "IF(Height*1> " & G & " + 0.125*" & intRowIndex1 - 1 & " ,Height*1-(0.125*" & I & "),0)"
                   
                Set vsoRow1 = ActiveWindow.Selection(1).Section(visSectionConnectionPts).Row(intRowIndex1)
                vsoRow1.Cell(visCnnctX).FormulaU = WString
                vsoRow1.Cell(visCnnctY).FormulaU = HString
                vsoRow1.Cell(visCnnctDirX).FormulaU = -1#
                vsoRow1.Cell(visCnnctDirY).FormulaU = 0#
                vsoRow1.Cell(visCnnctType).FormulaU = visCnnctTypeInward
           
                Next I
            End If
        End If
   
End Sub


I use Visio 2013 Pro at work and 2016 Pro at home