### Author Topic: Arrange selected shapes  (Read 6933 times)

0 Members and 1 Guest are viewing this topic.

#### Thomas Winkel

• Full Member
• Posts: 194
##### Arrange selected shapes
« on: July 06, 2013, 08:03:05 AM »
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   NextEnd Sub``

#### JuneTheSecond

• Hero Member
• Posts: 1027
##### Re: Arrange selected shapes
« Reply #1 on: July 08, 2013, 07:24:31 AM »
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.
« Last Edit: November 21, 2013, 05:13:46 AM by Visio Guy »
Best Regards,

Junichi Yoda
http://june.minibird.jp/

#### Thomas Winkel

• Full Member
• Posts: 194
##### Re: Arrange selected shapes
« Reply #2 on: July 09, 2013, 08:25:37 AM »
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

• Sr. Member
• Posts: 328
##### Re: Arrange selected shapes
« Reply #3 on: November 04, 2013, 09:34:46 AM »
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

• Full Member
• Posts: 194
##### Re: Arrange selected shapes
« Reply #4 on: January 25, 2014, 11:59:56 PM »
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

• Sr. Member
• Posts: 328
##### Re: Arrange selected shapes
« Reply #5 on: January 26, 2014, 02:57:51 AM »
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

Cheers,
Andrei

#### Thomas Winkel

• Full Member
• Posts: 194
##### Re: Arrange selected shapes
« Reply #6 on: January 26, 2014, 05:54:31 AM »
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 = iNext``
« Last Edit: January 26, 2014, 05:56:34 AM by ThomasWi »

#### kiler40

• Sr. Member
• Posts: 328
##### Re: Arrange selected shapes
« Reply #7 on: January 26, 2014, 02:47:42 PM »
thanks for the explanation
i`m not good in macros, but i understand your point

#### Thomas Winkel

• Full Member
• Posts: 194
##### Re: Arrange selected shapes
« Reply #8 on: May 02, 2016, 08:34:50 AM »
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, TrueEnd Sub``

#### Thomas Winkel

• Full Member
• Posts: 194
##### Re: Arrange selected shapes
« Reply #9 on: July 26, 2016, 05:39:39 PM »
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
« Last Edit: August 03, 2016, 01:17:45 PM by Thomas Winkel »