Add connection points to shapes x4,x8,x16,x32

Started by Frack Flowchart, July 05, 2016, 04:48:59 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Frack Flowchart

I'm trying to write a sub/function that will take a shape and add n connection points to it distributed around the shape. For example, if I wanted a shape to have 8 connection points distributed around it that scale when the shape does, I'd call the sub with the shape and 8 for number of divisions.

I'm having real trouble doing this automatically and have separate subs for each type of divisio (4 parts, 8 parts). How can I make this work?

What I have below for 8 parts is an example of what I'm doing

Public Sub CP_Add_Square_Eighths(theShape As Shape)
   
    Shape_Add_CP_XY theShape, "=width/2", "=height/2"
   
    Shape_Add_CP_XY theShape, "=width", "=height/4"
    Shape_Add_CP_XY theShape, "=width", "=height-(height/4)"
    Shape_Add_CP_XY theShape, "0", "=height/4"
    Shape_Add_CP_XY theShape, "0", "=height-(height/4)"
    Shape_Add_CP_XY theShape, "=width/4", "0"
    Shape_Add_CP_XY theShape, "=width-(width/4)", "0"
    Shape_Add_CP_XY theShape, "=width/4", "=height"
    Shape_Add_CP_XY theShape, "=width-(width/4)", "=height"
   
   
    Shape_Add_CP_XY theShape, "=width/2", "=height"
    Shape_Add_CP_XY theShape, "=width/2", "0"
    Shape_Add_CP_XY theShape, "=width", "=height/2"
    Shape_Add_CP_XY theShape, "0", "=height/2"
    ' corner points
End Sub

Sub Shape_Add_CP_XY(theShape As Shape, sX As String, sY As String)
    Dim rowNumber As Integer
    rowNumber = theShape.AddRow(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.VisRowTags.visTagCnnctPt)
    theShape.CellsSRC(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.visX).Formula = sX
    theShape.CellsSRC(Visio.visSectionConnectionPts, Visio.visRowConnectionPts, Visio.visY).Formula = sY
End Sub


vojo

VBA aside, its a bit more complicated then your macro suggests

For example, assume you want 4 evenly spaced connection points on a side
Then width/5 is the interval and you want
    connection point 1 = 1* width/5, height*1
    connection point 4 = 4*width/5, height *1

Also, the specific case of a square is pretty simple
A circle is more complex yet
    connection point n = n * R * cos(360/(N+1)), n*R*sin(360/(N+1))
    where n = slice  R is the radius (sqrt((width/2)^2+(height/2)^2)   N = total connection points you want

Ellipsis are even uglier.

What I would do would be
- take shape in question
- open shapesheet and add connection points via formulas...until you get the results you want
- Then work to code into VBA.

wapperdude

Assuming the question is how to facilitate the choice of the number of connection points per shape, the use  and creation of a custom user form would do this.  The form could allow selection from a list, or check boxes, or an arbitrary number of points.  The form would call the appropriate macro based upon the input.  Whether there are multiple macros or a single macro to do the actual work is irrelevant ... it's just code.  Multiple macs makes the coding easier to do.

Wapperdude
Visio 2019 Pro

wapperdude

#3
Well, decided to re-address this topic...in case someone stumbles across it and wants a solution. 

Yes, there probably are a variety of solutions for doing this out there in the all pervading ether.  But, I wanted to see how difficult it might be.  Not so bad.  It's quite repetitive. 

Rather than creating a single, all encompassing macro that uses an interface to get the number of points, I took the approach that there would be separate macros for each desired point count.  Yep.  Pretty lazy.  However, there is enough structure in the program, that someone with initiative could convert it...sort of the unified macro of connection point addition.

I'm just adding the code, no sample file...


Sub addCpt8()
'This is for the case of 8 total points to be added to selected shape.
'The macro is hard coded for this specific case.  Assumes, that there is
'a specific macro for number of connection points per shape.

'Code is structured using CASE STATEMENTS:  one case for each side of shape.
'It also uses WITH STATEMENT for code typing shorthand

    Dim vsoRow As Visio.Row
    Dim vsoShp As Visio.Shape
    Dim intRowIndex As Integer
    Dim shpEdge As Integer
    Dim i As Integer
    Dim j As Integer
    Dim numSidePts As Integer
   
    numSidePts = 2           'This is number of connection points per side
   
    If Visio.ActiveWindow.Selection.Count <> 1 Then  'Requires a shape to be selected.
        MsgBox "Select a shape, then re-run macro."
        Exit Sub
    Else
        Set vsoShp = ActiveWindow.Selection(1)
    End If
   
    For shpEdge = 1 To 4                        'Loop thru each edge of shape.  Only rectilinear shapes considered.
        Select Case shpEdge
            Case 1                              'Beginning edge is Left rising edge
                For i = 0 To numSidePts - 1
                    intRowIndex = vsoShp.AddRow(visSectionConnectionPts, visRowLast, visTagCnnctPt)         'There is new row for each connection point added
                    Set vsoRow = vsoShp.Section(visSectionConnectionPts).Row(intRowIndex)
                    With vsoRow
                        .Cell(visCnnctX).FormulaU = "Width*0"
                        If i = 0 Then
                            .Cell(visCnnctY).FormulaU = "Height*0.25"
                        Else
                            .Cell(visCnnctY).FormulaU = "Height*0.75"
                        End If
                        .Cell(visCnnctDirX).FormulaU = 1#
                        .Cell(visCnnctDirY).FormulaU = 0#
                        .Cell(visCnnctType).FormulaU = visCnnctTypeInward
                    End With
                Next
            Case 2                              '2nd edge is the top edge
                For i = 0 To numSidePts - 1
                    intRowIndex = vsoShp.AddRow(visSectionConnectionPts, visRowLast, visTagCnnctPt)         'There is new row for each point added
                    Set vsoRow = vsoShp.Section(visSectionConnectionPts).Row(intRowIndex)
                    With vsoRow
                        .Cell(visCnnctY).FormulaU = "Height*1"
                        If i = 0 Then
                            .Cell(visCnnctX).FormulaU = "Width*0.25"
                        Else
                            .Cell(visCnnctX).FormulaU = "Width*0.75"
                        End If
                        .Cell(visCnnctDirX).FormulaU = 1#
                        .Cell(visCnnctDirY).FormulaU = 0#
                        .Cell(visCnnctType).FormulaU = visCnnctTypeInward
                    End With
                Next
            Case 3                              '3rd edge is right, falling edge
                For i = 0 To numSidePts - 1
                    intRowIndex = vsoShp.AddRow(visSectionConnectionPts, visRowLast, visTagCnnctPt)         'There is new row for each point added
                    Set vsoRow = vsoShp.Section(visSectionConnectionPts).Row(intRowIndex)
                    With vsoRow
                        .Cell(visCnnctX).FormulaU = "Width*1"
                        If i = 0 Then
                            .Cell(visCnnctY).FormulaU = "Height*0.75"       'Note, order is reversed, so the points remain sequentally placed
                        Else
                            .Cell(visCnnctY).FormulaU = "Height*0.25"
                        End If
                        .Cell(visCnnctDirX).FormulaU = 1#
                        .Cell(visCnnctDirY).FormulaU = 0#
                        .Cell(visCnnctType).FormulaU = visCnnctTypeInward
                    End With
                Next
            Case 4                              '4th edge is the bottom edge
                For i = 0 To numSidePts - 1
                    intRowIndex = vsoShp.AddRow(visSectionConnectionPts, visRowLast, visTagCnnctPt)         'There is new row for each point added
                    Set vsoRow = vsoShp.Section(visSectionConnectionPts).Row(intRowIndex)
                    With vsoRow
                        .Cell(visCnnctY).FormulaU = "Height*0"
                        If i = 0 Then
                            .Cell(visCnnctX).FormulaU = "Width*0.75"
                        Else
                            .Cell(visCnnctX).FormulaU = "Width*0.25"
                        End If
                        .Cell(visCnnctDirX).FormulaU = 1#
                        .Cell(visCnnctDirY).FormulaU = 0#
                        .Cell(visCnnctType).FormulaU = visCnnctTypeInward
                    End With
                Next
        End Select
    Next

End Sub


Enjoy!
Wapperdude
Visio 2019 Pro

Miguel

Hello,

I decided to reply this topic because the program works only with shapes with 4 sides. How can you to do this with a triangle or a circle ?

Surrogate

Quote from: Miguel on March 29, 2017, 08:59:47 AMHow can you to do this with a triangle or a circle ?
it need new code !
that utility can place points on circles

but it have only russian interface  ::)
read more: Mass placement of connection points on shapes

wapperdude

QuoteI decided to reply this topic because the program works only with shapes with 4 sides. How can you to do this with a triangle or a circle ?

I am in the process of updating the code, but, it will take some time.  The goal will be to allow any (within reason) number of sides for a recti-linear shape, from 1 to some number..., and will do circles, but no ovals and no non-linear row types.  Initial release may be only 1 to 4 sides.

It will have a more user friendly interface.

Wapperdude
Visio 2019 Pro

Miguel

Quote from: wapperdude on March 30, 2017, 05:51:34 AMI am in the process of updating the code, but, it will take some time.  The goal will be to allow any (within reason) number of sides for a recti-linear shape, from 1 to some number..., and will do circles, but no ovals and no non-linear row types.  Initial release may be only 1 to 4 sides.

It will have a more user friendly interface.

Ok, it's perfect. I will show patience! Thank you  ;D ;D