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.