auto aligning shapes in a circle

M

Mighty

I'm doing up a couple of network diagrams, and one of our networks is
a hub/spoke topology. Is it possible to select a bunch of shapes,
and automatically lay them out in a circle? I can do it manually,
but getting the spacing right is killing me... there's 150+ shapes to
layout!
 
A

AlEdlund

It has to be done with code. John Marshall has some code on his site
(visio.mvps.org) for polar arrays.
al
 
M

Mighty

Beautiful, that does the trick nicely.

For anyone who comes across this thread in their own desperate hour
(Visio 2007, but shouldn't be too different in 2003):


1) Open a Visio document. Select the shape (abovementioned code
doesn't arrange existing ones, it takes a sample shape, copies it x
times and arranges it around the circle you specify the dimensions
of).

2) http://visio.mvps.org/VBA.htm, scroll down to Polar Array. Select
the code and ctrl+c to the clipboard. Go to Tools --> Macro -->
Visual Basic Editor. Double click on the "ThisDocument" object for
your Visio Drawing. Paste code from your clipboard. Close the
editor.

3) In the Visio window (with your sample shape selected), go to Tools
--> Macro --> ThisDocument --> Polar Array. Answer the prompts (#
of items to place, size of circle, angle of first item on circle), and
you're done.
 
J

John... Visio MVP

Thanks for pointing that out. I have added a request to my to-do list to add
some code to use the selection rather than repeatedly dropping a specific
shape.

(Or it is another excuse to dust off the blog. ;-) )

John...

Beautiful, that does the trick nicely.

For anyone who comes across this thread in their own desperate hour
(Visio 2007, but shouldn't be too different in 2003):


1) Open a Visio document. Select the shape (abovementioned code
doesn't arrange existing ones, it takes a sample shape, copies it x
times and arranges it around the circle you specify the dimensions
of).

2) http://visio.mvps.org/VBA.htm, scroll down to Polar Array. Select
the code and ctrl+c to the clipboard. Go to Tools --> Macro -->
Visual Basic Editor. Double click on the "ThisDocument" object for
your Visio Drawing. Paste code from your clipboard. Close the
editor.

3) In the Visio window (with your sample shape selected), go to Tools
--> Macro --> ThisDocument --> Polar Array. Answer the prompts (#
of items to place, size of circle, angle of first item on circle), and
you're done.
 
A

AlEdlund

Hey John,
Judy and I'll be in the neighborhood in about two weeks. We'll wave on the
way...
:)
al
 
C

Chris Roth [Visio MVP]

Some of my forum readers (most credit to "wapperdude"!) have been
dinking around with this, starting with John's code, I think.

Have a look at this thread:

Circle up the wagons, the arc is here!
href="http://visguy.com/vgforum/index.php?topic=566.msg2396#msg2396

And on a related note for those who stumble upon this thread:

Circular Text Generator (version 2)
http://www.visguy.com/2008/01/05/circular-text-generator-version-2/


--
Hope this helps,

Chris Roth
Visio MVP


Visio Guy: Smart Graphics for Visual People

Articles: http://www.visguy.com
Shapes: http://www.visguy.com/shapes
Dev: http://www.visguy.com/category/development/
Forum: http://www.viguy.com/vgforum
 
J

John... Visio MVP

Rather than wait for the blog, here is the bare code. It still needs some
error checking and other refinements.
If nothing is selected, it runs the old code. if something is selected, then
it arranges them in a circle. I have disabled the code that rotates the
shapes and have left them vertical. If this was to be used for something
like a set of chairs around a table, then the shape rotation should be used.

Option Explicit

Sub PolarArray()
' by Chris Roth
Dim shp As Visio.Shape, shpObj As Visio.Shape, celObj As Visio.Cell
Dim iNum As Integer, i As Integer
Dim dRad As Double, dAngStart As Double, dAng As Double
Dim x As Double, y As Double
Dim VsoSelect As Visio.Selection
Dim VsoShape As Visio.Shape

' obtain the shape to be distributed
Set shp = Visio.ActiveWindow.Selection(1)

Const PI = 3.14159265358

Set VsoSelect = Visio.ActiveWindow.Selection

If VsoSelect.Count > 0 Then
iNum = VsoSelect.Count
dRad = InputBox("Enter the radius for the polar array in inches:",
"Polar Array")
dAngStart = InputBox("Enter the first angle in degrees (0 deg = 3
o'clock):", "Polar Array")
dAngStart = dAngStart * PI / 180 'Convert to radians

dAng = 2 * PI / iNum

For Each VsoShape In VsoSelect

For i = 1 To iNum
x = dRad * Cos(dAngStart + dAng * (i - 1)) + 4.25
y = dRad * Sin(dAngStart + dAng * (i - 1)) + 5.5
Set VsoShape = VsoSelect(i)
' Set shpObj = Visio.ActivePage.Drop(shp, x, y)
VsoShape.Cells("Pinx").Formula = x
VsoShape.Cells("piny").Formula = y
' rotate the shape
' Set celObj = VsoShape.Cells("Angle")
' celObj.Formula = Str(Int((i - 1) * 360 / iNum)) + "deg."
Next i
Next VsoShape

Else
iNum = InputBox("Enter the number of items in the array:", "Polar
Array")
dRad = InputBox("Enter the radius for the polar array in inches:",
"Polar Array")
dAngStart = InputBox("Enter the first angle in degrees (0 deg = 3
o'clock):", "Polar Array")
dAngStart = dAngStart * PI / 180 'Convert to radians

dAng = 2 * PI / iNum

For i = 1 To iNum
x = dRad * Cos(dAngStart + dAng * (i - 1)) + 4.25
y = dRad * Sin(dAngStart + dAng * (i - 1)) + 5.5
Set shpObj = Visio.ActivePage.Drop(shp, x, y)
shpObj.Text = i
' rotate the shape
Set celObj = shpObj.Cells("Angle")
celObj.Formula = Str(Int((i - 1) * 360 / iNum)) + "deg."
Next i
End If
End Sub

John... Visio MVP
Beautiful, that does the trick nicely.

For anyone who comes across this thread in their own desperate hour
(Visio 2007, but shouldn't be too different in 2003):


1) Open a Visio document. Select the shape (abovementioned code
doesn't arrange existing ones, it takes a sample shape, copies it x
times and arranges it around the circle you specify the dimensions
of).

2) http://visio.mvps.org/VBA.htm, scroll down to Polar Array. Select
the code and ctrl+c to the clipboard. Go to Tools --> Macro -->
Visual Basic Editor. Double click on the "ThisDocument" object for
your Visio Drawing. Paste code from your clipboard. Close the
editor.

3) In the Visio window (with your sample shape selected), go to Tools
--> Macro --> ThisDocument --> Polar Array. Answer the prompts (#
of items to place, size of circle, angle of first item on circle), and
you're done.
 
M

Moisture Meter

Love your work mate (and Chris and everyone else that has done work on
this). The below code works perfectly. Wish I'd saved my earlier
document with all the correctly-named shapes now :)

Cheers,
Brett
 
M

Mighty

Oh good. google groups remembered one of my test gmail account logins
instead. below thanks were from original poster.

Cheers,
Brett
 
W

WapperDude

The macro associated with the Circle the Wagons post will place a selected
shape in either a circle or in an arc. The latest incarnation adds rainbow
color option.

John's code? Chris' code? I think the history of the polar array macro is
the original written by Chris and posted on John's site. It is the basis for
the arc array macro, which has added error checking, options, and is posted
on Chris' site. Funny world, eh?

For the present application, either the Polar or Arc macros should work fine.

Wapperdude
 
Joined
Nov 19, 2022
Messages
1
Reaction score
0
This code will do it. You select the shapes in the order that you want them arrange in a clockwise manner beginning from top/center position of the circle (if you want shape A to be at the top of the circle then shape A is what you select first). It uses the distance between the further left and the further right objects that you have selected as the diameter of the circle (if shape X if the furthest left shape that is selected and shape Y is the furthest right then the diameter of the circle will be the center-to-center difference between the two on the X axis). Play with the equation for rX(I) and rY(I) if you want to change the mentioned behavior of the Sub (the "-1 * " by the Cos is what makes it clockwise so you can remove that and it will become counter clockwise).


Sub CircleUp()

Dim sList As Visio.Selection
Set sList = Application.ActiveWindow.Selection
sList.IterationMode = Visio.visSelModeSkipSub

Dim sCount As Long
sCount = sList.Count

Dim sPosX() As Double
Dim sPosY() As Double
Dim iTop, iLeft, iBottom, iRight As Integer
Dim nTop, nLeft, nBottom, nRight, nRad, dY, dX, cX, cY As Double
Dim rX() As Double
Dim rY() As Double
Dim pX() As Double
Dim pY() As Double

Dim nList() As Shape

ReDim sPosX(sCount)
ReDim sPosY(sCount)
ReDim pX(sCount)
ReDim pY(sCount)
ReDim rX(sCount)
ReDim rY(sCount)
ReDim nList(sCount)

iLeft = 1
iTop = 1
iRight = 1
iBottom = 1

For I = 1 To sCount
sPosX(I) = sList(I).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).Result("mm")
sPosY(I) = sList(I).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).Result("mm")
If sPosX(I) < sPosX(iLeft) Then iLeft = I
If sPosY(I) > sPosY(iTop) Then iTop = I
If sPosX(I) = sPosX(iLeft) Then
If sPosY(I) > sPosY(iTop) Then iTop = I
End If
If sPosY(I) = sPosY(iTop) Then
If sPosX(I) < sPosY(iLeft) Then iLeft = I
End If
If sPosX(I) > sPosX(iRight) Then iRight = I
If sPosY(I) < sPosY(iBottom) Then iBottom = I
rX(I) = -1 * Sin((2 * 3.1416 / sCount) * (sCount - I + 1))
rY(I) = Cos((2 * 3.1416 / sCount) * (sCount - I + 1))
Next I

nLeft = sPosX(iLeft)
nRight = sPosX(iRight)
nTop = sPosY(iTop)
nBottom = sPosY(iBottom)

dX = nRight - nLeft
dY = nTop - nBottom

nRad = dX / 2
cX = nRad + nLeft
cY = nTop - nRad

For I = 1 To sCount
pX(I) = cX + (rX(I) * nRad)
pY(I) = cY + (rY(I) * nRad)
Next I
For I = 1 To sCount
sList(I).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).Result("mm") = pX(I)
sList(I).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).Result("mm") = pY(I)
Next I
End Sub
 
Last edited:

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top