creating a SPIRAL of stars in Excel

[jason]

I've seen some code in word for creating a spiral of stars on a
document.
I'm trying to adapt this to Excel.So far I have this:-

Const pi = 3.1416
Dim t As Single
Dim i As Integer
Dim z As Single
Dim x As Single, y As Single
Dim n As Single 'number of stars per cycle
Dim k As Single 'length of spiral
Dim sSize As Single 'star size
Dim sh As Shape

Sub DrawSpiral()

n = 80
k = 80000
sSize = 6

For i = 5 To n
t = k * pi * i / n
x = 2 * (1 / t) * Sin(t) * 100000000
y = 2 * (1 / t) * Cos(t) * 1000000

Set sh = ActiveSheet.Shapes.AddShape(msoShape5pointStar, x, y,
sSize, sSize)
Next i

End Sub

Unfortunately it just creates a shower of stars.Not altogether
unattractive!but not what I'm after.One of the problems I think is
that there seems to be an extra argument for the addshape method in
word - a fifth argument which specifies a starting point.

Are there any mathematicians out there who can help??

J

 

[keepitcool]

yep..

im not really a mathemagician..
and it took some puzzling

but!
...spiral draws within a given range Range
...star grows while spiralling
...renamed variables which makes it easier to understand and dimension.

have fun!


Option Explicit

Sub DrawSpiral()
Dim x#, y#, n#, s#, z#, i%
Dim poleX#, poleY#, rMax# 'Coordinates

Dim nSpokes%, nCircles# 'Quantities
Dim sMin#, sMax# 'Sizes

nSpokes = 20
nCircles = 4.25
sMin = 5
sMax = 20

With [a1:f15]
'Pole position
poleX = (.Left + .Width - sMax) / 2
poleY = (.Top + .Height - sMax) / 2
'Outside radius
rMax = WorksheetFunction.Min(poleX - .Left, poleY - .Top)
End With

ActiveSheet.DrawingObjects.Delete
n = nCircles * nSpokes
For i = nSpokes / 4 To n
z = 2 * WorksheetFunction.pi * i / nSpokes
x = poleX + rMax * Cos(z) * i / n
y = poleY + rMax * Sin(z) * i / n
s = sMin + i * (sMax - sMin) / n
ActiveSheet.Shapes.AddShape msoShape5pointStar, x, y, s, s
Next i

End Sub


keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >

 

[jason]

"not much of a mathematician" - hmmmmm - think u may be more of a
mathematician than you think!

Thanks KeepitCool

J

yep..

im not really a mathemagician..
and it took some puzzling

but!
..spiral draws within a given range Range
..star grows while spiralling
..renamed variables which makes it easier to understand and dimension.

have fun!


Option Explicit

Sub DrawSpiral()
Dim x#, y#, n#, s#, z#, i%
Dim poleX#, poleY#, rMax# 'Coordinates

Dim nSpokes%, nCircles# 'Quantities
Dim sMin#, sMax# 'Sizes

nSpokes = 20
nCircles = 4.25
sMin = 5
sMax = 20

With [a1:f15]
'Pole position
poleX = (.Left + .Width - sMax) / 2
poleY = (.Top + .Height - sMax) / 2
'Outside radius
rMax = WorksheetFunction.Min(poleX - .Left, poleY - .Top)
End With

ActiveSheet.DrawingObjects.Delete
n = nCircles * nSpokes
For i = nSpokes / 4 To n
z = 2 * WorksheetFunction.pi * i / nSpokes
x = poleX + rMax * Cos(z) * i / n
y = poleY + rMax * Sin(z) * i / n
s = sMin + i * (sMax - sMin) / n
ActiveSheet.Shapes.AddShape msoShape5pointStar, x, y, s, s
Next i

End Sub


keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >

I've seen some code in word for creating a spiral of stars on a
document.
I'm trying to adapt this to Excel.So far I have this:-

Const pi = 3.1416
Dim t As Single
Dim i As Integer
Dim z As Single
Dim x As Single, y As Single
Dim n As Single 'number of stars per cycle
Dim k As Single 'length of spiral
Dim sSize As Single 'star size
Dim sh As Shape

Sub DrawSpiral()

n = 80
k = 80000
sSize = 6

For i = 5 To n
t = k * pi * i / n
x = 2 * (1 / t) * Sin(t) * 100000000
y = 2 * (1 / t) * Cos(t) * 1000000

Set sh = ActiveSheet.Shapes.AddShape(msoShape5pointStar, x, y,
sSize, sSize)
Next i

End Sub

Unfortunately it just creates a shower of stars.Not altogether
unattractive!but not what I'm after.One of the problems I think is
that there seems to be an extra argument for the addshape method in
word - a fifth argument which specifies a starting point.

Are there any mathematicians out there who can help??

J

 

[keepitcool]

Jason,

I've tried emailing you with an "improved" version.
bounced small wonder!

This may be of interest for the math/theory..
http://www.2dcurves.com/spiral/spirallo.html

Fixed:
plotting of stars: centre rather than topleft.

Added:
accelerator
starting angle
starting radius
direction


Just experiment a little with the settings..


Option Explicit

Sub DrawSpiral()

Const nStars = 100 'Stars to plot
Const nPower = 0.95 'Quadratic accelerator

Const nCircles = 4 'Full Rotation (# circles)
Const nCircle0 = 0.25 'Starting Rotation (# circles)
Const bClockWise = True 'Direction

Const rInner = 0.25 'InnerRadius/OuterRadius

Const sMin = 5 'Starting size of star
Const sMax = 20 'Ending size of stars

Dim i&, j! 'Counter
Dim x!, y! 'Positions
Dim s!, k! 'Size, Angle
Dim x0!, y0!, r0!, rN! 'Origin, Radii

'' Note:
'' Evenly distributed
'' nStars/nCircels => even
'' nPower => 1
''
'' Npower
'' > 1 will accelerate segment length
'' < 1 will decelerate segment length

With Worksheets.Add(before:=Sheets(1))
.Name = "Spiral" & Format(Time, "hhmmss")
With [a1:g30]
'Origin
x0 = (.Left + .Width) / 2
y0 = (.Top + .Height) / 2
'Radii
rN = WorksheetFunction.Min(x0 - .Left, y0 - .Top) - sMax / 2
r0 = rInner * rN
End With

With .Shapes
For i = 1 To nStars
'Distribution
j = (i - 1) ^ nPower / (nStars - 1) ^ nPower
'Star Size
s = sMin + (sMax - sMin) * j
'Angle
k = 2 * WorksheetFunction.pi * _
(nCircle0 + nCircles * j) * -bClockWise
x = x0 - s / 2 + Cos(k) * ((rN - r0 - s / 2) * j + r0 + s / 2)
y = y0 - s / 2 + Sin(k) * ((rN - r0 - s / 2) * j + r0 + s / 2)

.AddShape msoShape5pointStar, x, y, s, s
Next
End With

With .DrawingObjects.Group
.Name = "Spiral"
.ShapeRange.Fill.ForeColor.RGB = vbRed
.ShapeRange.Line.Visible = msoFalse
End With
End With
End Sub




keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >