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()
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
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.
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.
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 ?
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.
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
What you explain is exactly the use-case why I wrote this macro 8)
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:
For i = 1 To c.Count
Set shp1 = c.Item(i)
shp1.Text = i
Next
thanks for the explanation :)
i`m not good in macros, but i understand your point :)
Hi.
Fix for 1D Shapes:
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
Hi,
here the same in C#:
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