Visio Proximity Movement

Started by Abeiis, April 25, 2017, 07:04:56 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

wapperdude

#15
Regarding item 1):
In the example, add a layer to the yellow shapes, name it, uh, "Yellow".    ???  Then, make this new layer
the only assigned layer for the yellow shapes.  Put some non-yellow shapes in the yellow shape column.  Run the macro as usual.

Caution:  this is simple code.  Assumes all shapes are assigned to 1 layer, whatever it may be.  The code could be made more robust to:
   1) check for no assigned layers
   2) check for multiple assigned layers

Note1:  could assign unique layers to every shape, say, "LayC1", "LayC2", to establish
column identity and valid, sortable shapes within the column.


Sub Macro1()
'Uses layer property to distinguish valid shapes in a column.
'Note:  could assign unique layers to every shape, say, "LayC1", "LayC2", to establish
'column identity and valid sortable shapes within the column.

    Dim vShp As Shape
    Dim pShp As Shape
    Dim Xmin As Double, Xmax As Double  'Optional: sets horiz limits for shapes to be in same column
    Dim vLay As Layer

'Select shape to be moved and place it
    Set vShp = ActiveWindow.Selection(1)
    Xmin = vShp.CellsU("PinX").Result("in") - 1 'Limits are tentatively based upon selected shape position.  Not optimal.
    Xmax = vShp.CellsU("PinX").Result("in") + 1
    If vShp.LayerCount = 0 Then                         'If no layer assigned to shape, exit sub.
        MsgBox ("No layer assigned. Assign layer to shape and retry.")
    Else
        Set vLay = vShp.Layer(1)                   'get layer name of shape
   
        ActiveWindow.DeselectAll

'Select shapes in the column:
        For Each pShp In ActivePage.Shapes
            If pShp.Layer(1) = vLay Then
                If pShp.CellsU("PinX").Result("in") > Xmin And pShp.CellsU("PinX").Result("in") < Xmax Then
                    ActiveWindow.Select pShp, visSelect
                End If
            End If
        Next
       
        Application.ActiveWindow.Selection.Distribute visDistVertMiddle, False
       
    End If

End Sub


Not sure I understand item 2).  Are you saying that in the attached picture, this is not what you want?

Wapperdude
Visio 2019 Pro

wapperdude

Using "layers" as a way of identifying shapes in a column, that is, each shape has a layer that identifies the column it is in, then the code becomes really simple.  Select the shape to be re-arranged, get the layer assignment (only 1 allowed), then just search the page for all shapes with same assignment.


Sub Macro1()
'Uses layer property to distinguish valid shapes in a column.
    Dim vShp As Shape
    Dim pShp As Shape
    Dim vLay As Layer

'Select shape to be moved and place it
    Set vShp = ActiveWindow.Selection(1)
    If vShp.LayerCount = 0 Then                     'If no layer assigned to shape, exit sub.
        MsgBox ("No layer assigned. Assign layer to shape and retry.")
    Else
        Set vLay = vShp.Layer(1)                    'get layer name of shape
        ActiveWindow.DeselectAll

'Select shapes in the column:
        For Each pShp In ActivePage.Shapes
            If pShp.LayerCount = 0 Then GoTo Continue               'Special case: no layers assigned
            If pShp.LayerCount = 1 And pShp.Layer(1) = vLay Then    'Error check, must have only 1 layer assigned
                ActiveWindow.Select pShp, visSelect                 'Select shapes in column
            End If
Continue:
        Next
        ActiveWindow.Selection.Distribute visDistVertMiddle, False
    End If

End Sub


Wapperdude
Visio 2019 Pro

Abeiis

OK - to clear my point please reference to attach image - there you will find the controls and their order; they are linked to data as you can see on the right.

So, what I was asking in #2; is how after I move a control say 5 to the 3rd position, its ID would also change to "3" and the other controls would change accordingly - I know it is a lot to ask, but you can understand that, when done, it would save a lot of time during a leadership meeting.

wapperdude

That does complicate things.  It forces position tracking of each shape--not part of the distribution approach.

You don't want to be changing shape names. That means the text displayed needs to be a custom property.  You could make a index list, that keys off the y-location and displays the desired text.  Or, you could do the array thing and use the array position to determine the desired text. 

I assume there's other data associated with each shape, hence their re-positioning.  How is the data assigned?  Couldn't you just re-assign the data to the correct shape location?

Index list: 
http://visguy.com/vgforum/index.php?topic=5902.0
https://msdn.microsoft.com/en-us/library/office/ff768335.aspx

Wapperdude




Visio 2019 Pro

Abeiis

Thanks - I will give that a try.
1Q: Can you help me with a code that, on mouse release (left button) your code will run? so as I move a shape to its new location and release the mouse, the code would run to distribute the shapes.
Thanks!

Abeiis

and to answer your Q "I assume there's other data associated with each shape, hence their re-positioning.  How is the data assigned?  Couldn't you just re-assign the data to the correct shape location?", is YES, I can do that, I only thought you may came across that before.
You know - one would think Microsoft Visio developers would have incorporated these features to the product; as you can see, what I am asking fore is a real time saver and add value to Visio.

wapperdude

Not sure how much time I can spend on this.  I have other things to attend to.  Perhaps other contributors will add to this.  Also, take a try at it. Get stuck, share what you've got.  Everyone is volunteer here, most will help with suggestions, but don't have the time to take on a full-blown coding project.

Wapperdude
Visio 2019 Pro

Abeiis

Well, I thank you for all your help and I will share my findings once I get all the pieces in place.
Thank You!

Yacine

#23
Since Wapperdude gave up ( ;) ), I'll take over again and remind Abe about my first post in this topic.
It was about Lists and Containers. This is a feature available since V2010 and brings a neat function with it, namely LISTORDER() and it does exactly what its name promises: it returns the list order of the list item. There's not much to say more. The options for tweaking lists are numerous, but there are some very nice articles about them in the net (Google is your friend).
Hope you can get along with these hints.
Rgds,
Y.
Yacine

Abeiis

Hi Vacine,
Thanks for stepping in, but I also like to thank Wapperdude for his help.
As you may have noticed, I like data to Visio document and generate the diagram above automatically - this is done via code. then during the Leadership meeting, we move many of these processes to fit the new requirements - Therefore, if you think I can generate the same diagram with container for each column (there are 5-7 columns), then please let me know the instructions needed to embed.
To my understanding; if I move a process from one position and place it in-between two other processes in the same container, they will give way to the newly positioned process, align, and reorder; is that correct?

wapperdude

You're welcome Abeiis. 

Yacine was kidding around.  He knows I don't have newer Visio versions, so cannot contribute to container related issues. 

The container list will help, but I think you will still need index lookup, based on container result in order to update the shape text.  There also remains the issue of automatically triggering the macro.

Neither containers nor events are issues I can readily address.

Wapperdude
Visio 2019 Pro

Abeiis

#26
Regarding "also remains the issue of automatically triggering the macro.", I researched my options and found on MSDN one solution talking about "Application.MouseMove Event (Visio)".
https://msdn.microsoft.com/en-us/library/office/ff766075.aspx

I tried it, but it only works at opening the drawing file - I thought it would work as with Access Mouse Events... any thoughts is appreciated.

I also researched the List Control (see link) and Scott talked about the control text and how the control changed its order number but did not elaborate on how it was done; if you can shed some light on how he did it, I would appreciate it, Thanks!
https://www.youtube.com/watch?v=UNhxdSRGAmc


Yacine

#27
Hello Abe,
I also don't know lists very well. So I started the macro recorder and did some basic operations (adding a shape, moving a list item to another position and so on).

That's what I got:
1) adding a shape to a list:
dim newShp as shape
dim listShp as shape
PositionInList as integer

set newShape = Application.Documents.Item("Path to your stencil...\Lists.vsdx").Masters.ItemU("Master.6") 'Shape to drop
set listShp = ... find a strategy to identify the target list...

Application.ActivePage.DropIntoList , newShp, listShp, PositionInList

2) link this shape to a data row
RS = 1 'Recordset ID - in my case =1. Please check how to get the ID for a generic case.
RowNum - the row number - iterate over all the rows to draw your graph.

newShp.LinkToData RS, RowNum, False

3) Reorder the list items by means of a data field (eg mySort)

listShp.ContainerProperties.ReorderListMember newShp, mySort

HTH,
Y.
Yacine

wapperdude

#28
Adding to Yacine, thus, will assume you now have a listcontainer with shapes in it.  First, a disclaimer:  I have no way of testing the following to know if true and works. 

The code from above could still be used to move the shapes within the container.  It would no longer be necessary to use layers as you could use the parent listcontainer instead.  Saves adding a layer to each shape.  The code would need modification, not shown here, whether you use layers or not, since I believe the contained shapes are treated as subshapes. Thus, it might be necessary to push into the container first.  But, layers would still work once inside the container.  Also, I'm not sure is if the re-distribution which changes the position in the listcontainer automatically updates the listorder.  I think it should.

Then, after all the sorting has finished, below is proposed code to update the displayed shape identifier.  Note, the actual shape name has not changed, only this pseudo-identification.  As previously mentioned, you don't really want to muck around with shape name changes.

****************************************
*
*  Still need event code development to automatically fire the process.
*  Easy to use double click event in the shapesheet and use Runmacro function.
*  Not automatic, but much easier and quicker.  Does require shapesheet editing for each shape.
*
****************************************


'
'Add code:
'Iterate to find new position of each shape in the list container
'Update the displayed text.  Note, actual shape name will not necessary match what's displayed
'
'        Dim vChars1 As Characters
'        Dim MyPos as integer
'
'        For Each pShp In ActivePage.Shapes
'            If pShp.LayerCount = 0 Then GoTo Continue                     'Special case: no layers assigned
'            If pShp.LayerCount = 1 And pShp.Layer(1) = vLay Then    'Error check, must have only 1 layer assigned
'                MyPos = pShp.GetListMemberPosition(ShapeMember)                       
'                Set vChars1 = pShp.Characters
'                vChars1.Begin = 0
'                vChars1.End = 1
'                vChars1.AddCustomFieldU """Process"" & MyPos", visFmtNumGenNoUnits    'This inserts the displayed text for the shape, e.g., Process3
'            End If
'        Next
       


And the entire code module becomes:

Sub Macro1()
'Uses layer property to distinguish valid shapes in a column.
'******
'NOTE:  could use container as the property for shapes in column, but, note avail in V2007
'Add pseudo code to get container position...requires iterating thru shapes after re-distribution
'

    Dim vShp As Shape
    Dim pShp As Shape
    Dim vLay As Layer
    Dim vSel1 As Selection

'Select shape to be moved and place it
    Set vShp = ActiveWindow.Selection(1)
    If vShp.LayerCount = 0 Then                     'If no layer assigned to shape, exit sub.
        MsgBox ("No layer assigned. Assign layer to shape and retry.")
    Else
        Set vLay = vShp.Layer(1)                    'get layer name of shape
        ActiveWindow.DeselectAll
        Set vSel1 = ActiveWindow.Selection

'Select shapes in the column:
        For Each pShp In ActivePage.Shapes
            If pShp.LayerCount = 0 Then GoTo Continue                      'Special case: no layers assigned
            If pShp.LayerCount = 1 And pShp.Layer(1) = vLay Then     'Error check, must have only 1 layer assigned
                vSel1.Select pShp, visSelect                                          'Selected shapes are not highlighted
            End If
Continue:
        Next
        vSel1.Distribute visDistVertMiddle, False  'True adds guides, good for reposition begin/end shapes.
'
'Add pseudo code:
'Iterate to find new position of each shape in the list container
'Update the displayed text.  Note, actual shape name will not necessary match what's displayed
'
'        Dim vChars1 As Characters
'        For Each pShp In ActivePage.Shapes
'            If pShp.LayerCount = 0 Then GoTo Continue                     'Special case: no layers assigned
'            If pShp.LayerCount = 1 And pShp.Layer(1) = vLay Then    'Error check, must have only 1 layer assigned
'                MyPos = pShp.GetListMemberPosition(ShapeMember)                       
'                Set vChars1 = pShp.Characters
'                vChars1.Begin = 0
'                vChars1.End = 1
'                vChars1.AddCustomFieldU """Process"" & MyPos", visFmtNumGenNoUnits   'This inserts the displayed text for the shape, e.g., Process3
'            End If
'        Next
       
    End If

End Sub


Wapperdude
 
Visio 2019 Pro

wapperdude

I should also emphasize that Yacine's original response has multitude of links regarding containers and their behavior.  You really need to explore those.

Wapperdude
Visio 2019 Pro