Boids Model for Visualbots

Alright, here is my take on the Boids model as promised:

Public SwarmRange As Range, WanderRange As Range, TimeRange As Range
Public SwarmingBugs As Integer, WanderingBugs As Integer
Private Sub World1_OnSimBegin(ByVal World As World, ByVal Bugs As Bots, ByVal Cells As Cells)
 
    World.Random.Seed = 115
    World.Screen.Bounds = vbtWalled
    World.Screen.Resize 900, 400
    World.Screen.SetScale -1800, -800, 1800, 800
    World.Screen.Color = vbBlueGray
    World.Screen.FadeRate = 0.04
    World.Screen.FadeMode = True
    Cells.Hide
 
    RandomLoop = 0
    RandomNum = World.Random.Real(-20, 20)

    Bugs.Create 100
    Bugs.Shape = vbtTadpole
    Bugs.Shape.FillColor = vbRed
    Bugs.Shape.BorderVisible = False
    Bugs.Size = 50
    Bugs.Pen.Color = vbtLightBlue
    Bugs.Pen.Width = 5
    Bugs.Pen.Down
 
    Bugs.Tags.Add "align"
    Bugs.Tags.Add "converge"
    Bugs.Tags.Add "separate"
    Bugs.Tags.Add "velocity"
    Bugs.Tags("velocity") = 1
 
    Bugs.ViewField.Radius = 150
    Bugs.ViewField.Span = 360
    Bugs.Speed = 25
 
    'define Excel ranges to store results
    Set SwarmRange = ActiveSheet.Range("Q1")
    Set WanderRange = ActiveSheet.Range("R1")
    Set TimeRange = ActiveSheet.Range("S1")
 
    ActiveSheet.Columns(SwarmRange.Column).Clear
    ActiveSheet.Columns(WanderRange.Column).Clear
    ActiveSheet.Columns(TimeRange.Column).Clear
 
    SwarmRange.Value = "SwarmingBugs"
    WanderRange.Value = "WanderingBugs"
    TimeRange.Value = "Time"

End Sub

Private Sub World1_OnSimStep(ByVal World As World, ByVal Swarm As Bots, ByVal Cells As Cells)
 
    Dim Bug As Bot
    Dim ClosestBug As Bot
    Dim Neighbors As Group
    Dim TurnDirection As Double
    Dim AngleToPoint As Double
    'Dim RandomLoop As Integer
    'Dim RandomNum As Variant
    'Dim RandomChange As Variant 'for quadratic change in RandomNum
    SwarmingBugs = 0
    WanderingBugs = 0
 
    'random number generator - change RandomNum every 500 steps
    'uncomment this block and line 130 and Dims above.
 
    'If RandomLoop >= 5 Then
    '    RandomChange = RandomChange + World.Random.Real(-20, 20)
    '    RandomNum = RandomChange + RandomNum
    '    RandomLoop = 0
    'Else
    '    RandomLoop = RandomLoop + 1
    'End If

    'gather information
    For Each Bug In Swarm
 
        Set Neighbors = Bug.GroupNear
        Bug.Tags("align") = 0
        Bug.Tags("separate") = 0
        Bug.Tags("converge") = 0
     
        If Neighbors.Count > 1 Then
            Bug.Tags("align") = Neighbors.Avg("Dir") - Bug.Dir

         
            Set ClosestBug = Bug.Closest

            If Bug.DistTo(ClosestBug) <> 100 Then
                Bug.Tags("velocity") = (Bug.DistTo(Neighbors.Centroid) + Bug.DistTo(ClosestBug) * 0.5) / 20
            Else
                If Bug.AngleTo(Neighbors.Centroid) > 300 And Bug.DistTo(Neighbors.Centroid) > 100 Then
                    Bug.Tags("velocity") = (Bug.DistTo(Neighbors.Centroid) + Bug.DistTo(ClosestBug) * 0.5) / -20
                End If
            End If
         
        End If
                         
     'count, coloring, and stray behavior
     ' - add to SwarmingBugs and WanderingBugs variables
     ' - color Bug red if alone, green if in group
     ' - if alone, make Bug turn randomly and adjust to normal speed
        If Neighbors.Count < 2 Then
            Bug.Color = vbtRed
            Bug.TurnRand -20, 20
            Bug.Speed = 25
            WanderingBugs = WanderingBugs + 1
        Else
            Bug.Color = vbtBrightGreen
            SwarmingBugs = SwarmingBugs + 1
        End If
        
    Next Bug
            
    'action loop - change direction based on composite behavior
    For Each Bug In Swarm
        If Neighbors.Count > 1 Then
            TurnDirection = Bug.Tags("align") + Bug.Tags("separate") + Bug.Tags("converge") '+ RandomNum
            Bug.Turn TurnDirection
            If Bug.Speed < 1000 Then
                Bug.Speed = 25 + Bug.Tags("velocity")
            Else
                Bug.Speed = 1000
            End If
        End If
    Next Bug
    
    'set the values to be used in data recording
    TimeRange.Offset(World.Sim.Time).Value = World.Sim.Time
    WanderRange.Offset(World.Sim.Time).Value = WanderingBugs
    SwarmRange.Offset(World.Sim.Time).Value = SwarmingBugs
    
    'move Bugs
    Swarm.Step
    

End Sub

(In case you haven't read my previous post, this code was written for the VisualBots Excel add-in. It's completely safe, plus an easy yet powerful way to use BASIC programming.)

This is actually version 5.3. I plan to condense this a bit, get rid of the orphans, and reorganize it so I can have a v6. Enjoy!

~ROBO~