Arrange selected shapes

[Thomas Winkel]

I would like to share a feature that I recently added to my project.

It arranges all selected shapes relative to the first two ones.
The order is: upper left to lower right with priority left to right.

Usage:

• Arrange two shapes by hand as you like.
• Take care that all the other shapes are of lower order.
• Select all shapes to be arranged in that way (including shapes of point 1)
• Start arrangeSelectedShapes()

Code

Sub arrangeSelectedShapes()
   Dim shp1 As Shape
   Dim shp2 As Shape
   Dim c As New Collection
   Dim i As Integer
   Dim n As Integer
   Dim position As Integer
   Dim dX As Double
   Dim dY As Double
   Dim ShapeCount As Integer
   
   ShapeCount = ActiveWindow.Selection.Count
   
   If (ShapeCount < 3) Then
     MsgBox "Select three shapes minimum.", vbInformation
     Exit Sub
   End If
   
   c.Add ActiveWindow.Selection(1)

   For i = 2 To ShapeCount
     Set shp1 = ActiveWindow.Selection(i)
     position = i
     For n = 1 To c.Count
       Set shp2 = c.Item(n)
       If (shp1.Cells("PinY") > shp2.Cells("PinY")) Then
         position = n
         Exit For
       End If
       If (shp1.Cells("PinY") = shp2.Cells("PinY")) Then
         If (shp1.Cells("PinX") < shp2.Cells("PinX")) Then
           position = n
           Exit For
         End If
       End If
     Next
     If (position > c.Count) Then
       c.Add shp1
     Else
       Call c.Add(shp1, , position)
     End If
   Next

   Set shp1 = c.Item(1)
   Set shp2 = c.Item(2)
   dX = shp1.Cells("PinX") - shp2.Cells("PinX")
   dY = shp1.Cells("PinY") - shp2.Cells("PinY")

   For i = 1 To c.Count
     Set shp2 = c.Item(i)
     shp2.Cells("PinX") = shp1.Cells("PinX") - (i - 1) * dX
     shp2.Cells("PinY") = shp1.Cells("PinY") - (i - 1) * dY
   Next
End Sub

[JuneTheSecond]

Very cool, Thomas.
Your macro arranges all shape selected at once,
even if the shapes are quite different shape
in dimension, color or type.

Now, I remember a method I've heard long years ago from my frend.
I found it still works on Visio 2013.

It is a way to reproduce shapes arranging to one way.

1. Make a shape.
2. Copy shape.
3. Press F4 key.
4. Repeat F4 key anytimes.

[Thomas Winkel]

Yes, F4 is a very useful feature and it has some commonalities with arrangeSelectedShapes().
But F4 can only create new shapes.
We regularly have to arrange existing Shapes that are connected to data or shapes with user settings.

BTW.
Optimisation fetishists can count the last for-loop from 3 to c.Count in order to save a few milliseconds.

[kiler40]

Really Cool Yes !
Can this work not only in one row, but if it reaches for example end of the page to go to the next row ?

[Thomas Winkel]

Possible, yes.
But a very specific requirement (what is a row? Would you allow to place shapes over (or behind) other ones?).
Not every user will like that.

[kiler40]

No i mean if the shapes are identical by size and shape.
For example:
From excel you import 100 rows with data. you assign the first row to a master shape, an then if you select all other rows, drag and drop them in the page, the visio copies the same master shape with different data and place it one after another with offset (the sam will be if you select any randoom shape and press ctrl+D )
With the macros you share with us all the shapes can be sorted on one infinite row.
But can it go to the next row when the page ends, and to the next page when the first one is full

Just asking

Cheers,
Andrei

[Thomas Winkel]

What you explain is exactly the use-case why I wrote this macro 
But in our case it is impossible for me to know where the user like to start with a new row (or column).
In the worst case the macro will arrange shapes on top or behind other shapes on a page. This could be a lot of work to fix...
So, we work in smaller steps or just let the shapes arrange out of page and move single blocks by hand to their final position.
No chance for further automatism here, so I will not implement it.

If you like to adapt the code to your requirements you just need to modify the last for-loop.

For example, another use-case could be to (re)number shapes:

Code

For i = 1 To c.Count
    Set shp1 = c.Item(i)
    shp1.Text = i
Next

[kiler40]

thanks for the explanation
i`m not good in macros, but i understand your point

[Thomas Winkel]

Hi.

Fix for 1D Shapes:

Code

Sub arrangeSelectedShapes()
    Dim shp1 As Shape
    Dim shp2 As Shape
    Dim c As New Collection
    Dim i As Integer
    Dim n As Integer
    Dim Position As Integer
    Dim dX As Double
    Dim dY As Double
    Dim dPinX As Double
    Dim dPinY As Double
    Dim ShapeCount As Integer
    Dim UndoScopeID1 As Long
    
    UndoScopeID1 = Application.BeginUndoScope("Arrange Selection")
    
    ShapeCount = ActiveWindow.Selection.Count
    
    If (ShapeCount < 3) Then
        MsgBox "Select three shapes minimum.", vbInformation
        Exit Sub
    End If
    
    c.Add ActiveWindow.Selection(1)
    
    For i = 2 To ShapeCount
        Set shp1 = ActiveWindow.Selection(i)
        Position = i
        For n = 1 To c.Count
            Set shp2 = c.Item(n)
            If (shp1.Cells("PinY") > shp2.Cells("PinY")) Then
                Position = n
                Exit For
            End If
            If (shp1.Cells("PinY") = shp2.Cells("PinY")) Then
                If (shp1.Cells("PinX") < shp2.Cells("PinX")) Then
                    Position = n
                    Exit For
                End If
            End If
        Next n
        If (Position > c.Count) Then
            c.Add shp1
        Else
            Call c.Add(shp1, , Position)
        End If
    Next i
    
    Set shp1 = c.item(1)
    Set shp2 = c.item(2)
    dX = shp1.Cells("PinX") - shp2.Cells("PinX")
    dY = shp1.Cells("PinY") - shp2.Cells("PinY")
    
    For i = 1 To c.Count
        Set shp2 = c.item(i)
        If shp2.OneD Then
            dPinX = (shp1.Cells("PinX") - (i - 1) * dX) - shp2.Cells("PinX")
            dPinY = (shp1.Cells("PinY") - (i - 1) * dY) - shp2.Cells("PinY")
            shp2.Cells("BeginX") = shp2.Cells("BeginX") + dPinX
            shp2.Cells("EndX") = shp2.Cells("EndX") + dPinX
            shp2.Cells("BeginY") = shp2.Cells("BeginY") + dPinY
            shp2.Cells("EndY") = shp2.Cells("EndY") + dPinY
        Else
            shp2.Cells("PinX") = shp1.Cells("PinX") - (i - 1) * dX
            shp2.Cells("PinY") = shp1.Cells("PinY") - (i - 1) * dY
        End If
    Next i
    
    Application.EndUndoScope UndoScopeID1, True
End Sub

[Thomas Winkel]

Hi,

here the same in C#:

Code

public static void arrangeSelected()
{
	var app = Globals.ThisAddIn.Application;
	var shapeCount = app.ActiveWindow.Selection.Count;

	if (shapeCount < 3)
	{
		MessageBox.Show("Select three shapes minimum.", "wit");
		return;
	}

	var undoScope = app.BeginUndoScope("Arrange Shapes");
	app.ScreenUpdating = 0;
	var storeDeferRecalc = app.DeferRecalc;
	app.DeferRecalc = 1;

	var c = new Collection();

	c.Add(app.ActiveWindow.Selection[1]);

	Visio.Shape shp1;
	Visio.Shape shp2;

	for (var i = 2; i <= shapeCount; i++)
	{
		shp1 = app.ActiveWindow.Selection[i];
		var position = i;
		for (var n = 1; n <= c.Count; n++)
		{
			shp2 = (Visio.Shape)c[n];
			if (shp1.Cells["PinY"].ResultIU > shp2.Cells["PinY"].ResultIU)
			{
				position = n;
				break;
			}
			if (shp1.Cells["PinY"].ResultIU == shp2.Cells["PinY"].ResultIU)
			{
				if (shp1.Cells["PinX"].ResultIU < shp2.Cells["PinX"].ResultIU)
				{
					position = n;
					break;
				}
			}
		}
		if (position > c.Count)
		{
			c.Add(shp1);
		}
		else
		{
			c.Add(shp1, Before: position);
		}
	}

	shp1 = (Visio.Shape)c[1];
	shp2 = (Visio.Shape)c[2];

	double dX = shp1.Cells["PinX"].ResultIU - shp2.Cells["PinX"].ResultIU;
	double dY = shp1.Cells["PinY"].ResultIU - shp2.Cells["PinY"].ResultIU;

	for (var i = 3; i <= c.Count; i++)
	{
		shp2 = (Visio.Shape)c[i];
		if (Convert.ToBoolean(shp2.OneD))
		{
			double dPinX = (shp1.Cells["PinX"].ResultIU - (i - 1) * dX) - shp2.Cells["PinX"].ResultIU;
			double dPinY = (shp1.Cells["PinY"].ResultIU - (i - 1) * dY) - shp2.Cells["PinY"].ResultIU;

			shp2.Cells["BeginX"].ResultIU = shp2.Cells["BeginX"].ResultIU + dPinX;
			shp2.Cells["EndX"].ResultIU = shp2.Cells["EndX"].ResultIU + dPinX;
			shp2.Cells["BeginY"].ResultIU = shp2.Cells["BeginY"].ResultIU + dPinY;
			shp2.Cells["EndY"].ResultIU = shp2.Cells["EndY"].ResultIU + dPinY;
		}
		else
		{
			shp2.Cells["PinX"].ResultIU = shp1.Cells["PinX"].ResultIU - (i - 1) * dX;
			shp2.Cells["PinY"].ResultIU = shp1.Cells["PinY"].ResultIU - (i - 1) * dY;
		}
	}

	app.EndUndoScope(undoScope, true);
	app.ScreenUpdating = 1;
	app.DeferRecalc = 0;
}

Maybe there are better ways to achieve this in C#?
The VBA solution is more than 3 times faster...!

Edit:
VBA was faster because I used .Result("mm") which requires permanent conversion between the units.
Now, with .ResultIU the speed is identical.

Regards,
Thomas