'Type holding details about every spoke
Private Type MyPointType
Length As Long 'Length of spoke
CCWAngle As Long 'Counter clockwise angle limit
'ie the next angle must be between this upper limit
'and the lower limit set by the clockwise angle
Angle As Long 'The actual angle drawn
CWAngle As Long 'Clockwise angle limit
CurX As Single 'Actual X position
CurY As Single 'Actual Y Position
Order As Long 'Position in order for joining lines
End Type
Dim Points() As MyPointType
'Type for details about the order of each spoke so that can connect lines
Private Type MyOrderType
CurX As Single 'Actual X position
CurY As Single 'Actual Y Position
End Type
Dim PointsOrd() As MyOrderType
Dim OrderStart() As Long 'Starting position in order of first line in each pass
Dim OrderJump() As Long 'How much to jump to get next in order for that pass
Private Const pi As Single = 3.14159265 'Constant for Pi
Private Const MaxRadius As Single = 128 'maximum length of spoke in pixels
Private Const LineRand As Long = 41 'Random length shortening of spokes in pixels
Private Const AngleRand As Single = 10 'Random percentage variance for each new angle
Private Const NumPasses As Long = 2 'Number of passes
Dim Loop1 As Long 'Generic loops
Dim Loop2 As Long
Private Sub Form_Load()
Randomize 'Start randomization
ReDim Points(1 To 2 ^ (NumPasses + 2)) 'Create array eg 2 passes = 16 lines
ReDim PointsOrd(1 To 2 ^ (NumPasses + 2)) 'Create array for lines in order
For Loop1 = 1 To 4 'Create starting axis
With Points(Loop1)
.Length = MaxRadius 'Full length lines
.CCWAngle = 90 * (Loop1 - 1) 'CCW limit of quadrant ie 0,90,180,270
.CWAngle = 90 * Loop1 'CW limit ie 90,180,270,360
.Angle = 90 * Loop1 'Actual angle ie 90,180,270,360
.Order = (2 ^ (NumPasses + 2)) / 4 * Loop1 'Where they appear in order of all spokes
'ie if there are 16 lines then the axis would be line 4,8,12 and 16
End With
Next
Me.Show 'Show form
With Picture1
.AutoRedraw = True 'Set to redraw if covered
.Width = Screen.TwipsPerPixelX * 300 'Set width based on screen res
.Height = Screen.TwipsPerPixelY * 300
Picture1.Scale (-150, -150)-(150, 150) 'scale pic to 300 x 300
End With
End Sub
Private Sub Command1_Click()
Dim CurrentPosn As Long 'Current line being worked on
Dim PreviousPosn As Long 'Previous line gives angle limits for current line
Dim TempAngle As Long 'Temp to store angle
Dim AngleRandDir As Integer 'Is new angle going to have a random offset
'in CCW or CW direction. Ie new angle is half way
'between previous angles then adjusted for variance
'of up to 10% (AngleRand) in direction chosen by this var
On Error Resume Next
With Picture1
.Cls 'Clear picture
.ForeColor = vbBlack 'Set forecolor
Picture1.Circle (0, 0), MaxRadius 'Draw starting circle
End With
'This section works out the starting points for lines in
'each new pass. So if doing 2 passes (16 lines) the first line
'in the 1st pass will be number 2 in order, the first in the
'second pass will be number 1 in order etc
'-----------------------------------------------------------------
ReDim OrderStart(1 To NumPasses)
ReDim OrderJump(1 To NumPasses)
For Loop1 = 0 To NumPasses
OrderStart(Loop1) = 2 ^ (NumPasses - Loop1) 'First line of this pass
OrderJump(Loop1) = 2 ^ (NumPasses - Loop1 + 1) 'Subsequent lines in
'this pass will be multiples of x
Next
'=================================================================
'This section calcs the angles of all spokes
'-----------------------------------------------------------------
For Loop1 = 1 To NumPasses 'Loop thru number of passes
For Loop2 = 1 To 2 ^ (Loop1 + 1) 'How many NEW lines in each pass
CurrentPosn = 2 ^ (Loop1 + 1) + Loop2 'Current line
'Where this line appears in the order of all lines
Points(CurrentPosn).Order = OrderStart(Loop1) + OrderJump(Loop1) * (Loop2 - 1)
AngleRandDir = -1 + 2 * Int(Rnd * 2) 'Get a random offset dir -1 or 1
If Loop1 = 1 Then 'First pass is diff from others because only one intermediate line
'-----------------------------------------------------------------
PreviousPosn = CurrentPosn - 4 'Get num of relative line in previous pass
'eg Line 5 is first line in pass 1. It checks
'Line 1 to find out the range of angles.. ie 0 to 90
With Points(CurrentPosn) 'With the new line
.Length = MaxRadius - Int(Rnd * LineRand) 'Random length
.CCWAngle = 90 * (PreviousPosn - 1) 'CCW limit for next pass
.CWAngle = 90 * PreviousPosn 'CW limit for next pass
'Actual angle of new spoke.
.Angle = .CCWAngle + (.CWAngle - .CCWAngle) / 2 + (.CWAngle - .CCWAngle) * (Rnd * AngleRand) / 100 * AngleRandDir
End With
'=================================================================
Else
'-----------------------------------------------------------------
PreviousPosn = (CurrentPosn + 1) \ 2 'Previous line to get angle
'limits from is current line divided by 2
'ie If on third pass lines 9 and 10
'use line 5 to get angle limits
With Points(PreviousPosn)
If CurrentPosn Mod 2 = 1 Then 'Are we creating a new line
'above or below the previous line
'If above get the angle limits
TempAngle = .CCWAngle + (.Angle - .CCWAngle) / 2 + (.Angle - .CCWAngle) * (Rnd * AngleRand) / 100 * AngleRandDir
Else
TempAngle = .Angle + (.CWAngle - .Angle) / 2 + (.CWAngle - .Angle) * (Rnd * AngleRand) / 100 * AngleRandDir
End If
End With
With Points(CurrentPosn)
.Length = MaxRadius - Int(Rnd * LineRand) 'Length of new line
If CurrentPosn Mod 2 = 1 Then
.CCWAngle = Points(PreviousPosn).CCWAngle
.Angle = TempAngle
.CWAngle = Points(PreviousPosn).Angle
Else
.CCWAngle = Points(PreviousPosn).Angle
.Angle = TempAngle
.CWAngle = Points(PreviousPosn).CWAngle
End If
End With
'=================================================================
End If
Next
Next
'=================================================================
'This section draws the actual spokes
'-----------------------------------------------------------------
For Loop1 = 1 To UBound(Points)
If Loop1 > 4 Then Picture1.ForeColor = vbBlue
With Points(Loop1)
.CurX = .Length * Cos(.Angle * (pi / 180))
.CurY = .Length * Sin(.Angle * (pi / 180))
Picture1.Line (0, 0)-(.CurX, .CurY)
PointsOrd(.Order).CurX = .CurX 'Where line is in order for connections
PointsOrd(.Order).CurY = .CurY
End With
Next
'=================================================================
'This section draws the actual connections between spokes
'-----------------------------------------------------------------
With Points(4) 'Starting point at 360 degrees
Picture1.CurrentX = .CurX
Picture1.CurrentY = .CurY
End With
Picture1.ForeColor = vbRed
For Loop1 = 1 To UBound(PointsOrd)
With PointsOrd(Loop1)
Picture1.Line -(.CurX, .CurY)
End With
Next
'=================================================================
End Sub
'Continued next post
Ploting Points,Math And Recurse
Reply With Quote
:MoMad: 
Buy the kids something nice with it.
