'========================================================================'
'Creat points on the curve ----------------------------------------------'

Function curvept (interval)
   
Dim strObject, arrStartPoint, arrEndPoint, arrContour, arrPoint
strObject = Rhino.GetObject("Select curve", 4)
arrPoints = Rhino.CurvePoints(strObject)
arrContour = Rhino.CurveContourPoints(strObject, arrPoints(UBound(arrPoints)), arrPoints(0), interval)
If IsArray(arrContour) Then
End If  
curvept = arrContour
End Function


'========================================================================'
'Creat points on the scene ----------------------------------------------'

Function createpoints 
   
  arrPts = Rhino.GetPoints(vbFalse, vbTrue, "Create points")
  If IsArray(arrPts) Then
    Rhino.AddPoints arrPts  
  End If
  
  
End Function

'========================================================================'
'POINTDISTANCE: Find Who's the neighbour---------------------------------'

Function pointsdistance (point, num, range)
  ReDim Preserve arrmultipts (num, num)
  
  
  
  For i = 0 To num 
    For j = 0 To num 
  
         pt1 = Rhino.pointcoordinates (point(i))
         pt2 = Rhino.pointcoordinates (point(j))
               
         dis = Rhino.distance(pt1,pt2)
         
        If (dis > 0 ) And (dis < range) Then
          arrmultipts(i,j) = point(j)
              
        Else 
          arrmultipts (i,j) = ""
         
        End If
      Next
  Next
  
  pointsdistance = arrmultipts
  
    
End Function

'========================================================================'
'RANDOMVECTOR: Assign random vector to Points  --------------------------'

Function randomvector (num,high)

  Dim arrtemp()
  ReDim arrtemp(num)
  
  low = 0
  For i = 0 To num
    arrtemp(i) = Array( Int((High - Low + 1) * Rnd)-(1+high)/2,Int((High - Low + 1) * Rnd)-(1+high)/2,Int((High - Low + 1) * Rnd)-(1+high)/2)
  Next
  
  randomvector = arrtemp
End Function

'========================================================================'
'ALGINMENT: Return average vector among neighbours   --------------------'

Function alignment (points, vector, num)
  Dim suggestvector(), sum
  ReDim suggestvector (num)
  
    For i = 0 To num 
      count = 1
    sum = Array(0,0,0)
   
      For j = 0 To num
        If Rhino.ispoint(points(i,j)) Then 'is neighbour'
          sum = Rhino.Vectoradd (sum,vector(j))
          count = count + 1
        End If
      Next
      suggestvector (i) = Rhino.vectoradd(sum,vector(i))
      suggestvector (i) = Rhino.vectorscale (suggestvector(i), 1/(count))
      suggestvector (i) = Rhino.vectorsubtract (suggestvector (i), vector(i))
      Next
    alignment = suggestvector
End Function


'========================================================================'
'SEPARATION: Return average vector to separate neighbours that are too close

Function Separation (pts, points,num, range, minrange)
  Dim  suggestvector(), vec
  ReDim suggestvector (num)

    For i = 0 To num                
          suggestvector (i) = Array(0,0, 0)
                  
      For j = 0 To num
           vec = Array(0,0,0)
      
       If Rhino.ispoint(points(i,j)) Then
           pt1 = Rhino.pointcoordinates(pts(i))
           pt2 = Rhino.pointcoordinates(pts(j))
           dis = Rhino.distance(pt1,pt2)
          
          If (dis < minrange) Then
            vec = Rhino.vectorsubtract(pt1 , pt2)
            vec = Rhino.Vectorscale (vec, (minrange - dis)/dis)
            suggestvector (i) = Rhino.Vectoradd( suggestvector (i), vec)     
          End If
         End If
       Next
     Next    
  
  separation = suggestvector 
 
  End Function

'========================================================================'
'COHESION: Return vector to cluster neighbour points towards average coordinate   -------------------------------------------------------'
  
Function Cohesion (pts, points, num)
  Dim suggestvector(), sum
  ReDim suggestvector (num)

  
    For i = 0 To num 
      count = 1
      sum = Array(0,0,0)
         
      pt1 = Rhino.pointcoordinates(pts(i))
      For j = 0 To num
        If Rhino.ispoint(points(i,j)) Then
          pt2 = Rhino.pointcoordinates(pts(j))
          sum = Rhino.Vectoradd (sum,pt2)
          count = count + 1
          End If
      Next
      aveposition = Rhino.Vectoradd (sum, pt1)
      aveposition = Rhino.Vectorscale (aveposition, 1/count)
      
      suggestvector (i) = Rhino.vectorsubtract( aveposition, pt1)
        
    Next
    
    Cohesion = suggestvector
  
End Function

'========================================================================'
'DRAW: Create path of the moving points  --------------------------------'

Function draw (pts,vector,num)
  Dim arrstart, arrend
  ReDim line(num)
  
  For i = 0 To num
  arrstart = Rhino.pointcoordinates(pts(i))
  arrend = Rhino.vectoradd (vector(i), arrstart)
  line(i)=Rhino.addline (arrstart, arrend)
  Next
      
End Function

'========================================================================'
'TARGET: Return Vector to lead point to the target destination  ---------

Function Target (pts,num,tpt, tptnum, dis)
  Dim suggestvector ()
  ReDim suggestvector (num)
  
  For i = 0 To num
    
    pt1 = Rhino.pointcoordinates(pts(i))
    displacement = Rhino.distance(pt1,tpt(tptnum(0)))
   
    If ((displacement) < dis) And ( tptnum(0) < UBound(tpt) ) Then
      tptnum(0) = tptnum(0) + 1
      End If
    
    suggestvector (i) = Rhino.vectorsubtract (tpt(tptnum(0)), pt1)
    suggestvector (i) = Rhino.vectorscale ( suggestevector (i), 1/displacement)
  Next
  target = suggestvector

End Function

'========================================================================'
'TARGET: Return Vector to lead point to the each target destination  ---------

Function Targetself (pts,num,tpt, tptnum, dis, currenttarget, drawcurrenttarget)
  Dim suggestvector ()
  ReDim suggestvector (num)
  
  For i = 0 To num
    
    pt1 = Rhino.pointcoordinates(pts(i))
    displacement = Rhino.distance(pt1,currenttarget(i))
   
    If ((displacement) < dis) And ( tptnum(i) < UBound(tpt) ) Then
      currenttarget(i) = Targetrelative(currenttarget(i),tpt,tptnum(i))
      tptnum(i) = tptnum(i) + 1
      If drawcurrenttarget = True Then
        Rhino.addpoint(currenttarget(i))
        End If
      End If
  
    suggestvector (i) = Rhino.vectorsubtract (currenttarget(i), pt1)
    suggestvector (i) = Rhino.vectorscale ( suggestvector (i), 1/displacement)
        Next
 targetself = suggestvector

End Function

'========================================================================'
'TARGETrelative --------return the set of the relative targets -----------

Function Targetrelative ( pt,tpt, num )
  Dim angle
    
  oldvector = Rhino.vectorcreate (pt,tpt(num))
    
  If (num<(UBound(tpt)-1)) Then
  vector1 = Rhino.vectorcreate (tpt(num), tpt(num+1))
  vector2 = Rhino.vectorcreate (tpt(num+1), tpt(num+2))
  vectoraxle = Rhino.VectorCrossProduct (Vector1, Vector2)
  dotproduct = Rhino.VectorDotProduct ( Vector1,Vector2)
  length1 = Rhino.VectorLength (Vector1)
  length2 = Rhino.VectorLength (Vector2)
  angle = dotproduct / ( length1 * length2)
  angle = Rhino.Acos (angle)
  angle = Rhino.todegrees (angle)
  newvector=Rhino.VectorRotate (oldvector,angle, vectoraxle)
  Else
  newvector =oldvector
  
  End If
  Targetrelative = Rhino.vectoradd ( newvector, tpt(num+1))
End Function

'========================================================================'
'Average distance -------------------------------------------------------'

Function averagedis (points, totalnum)

  avdis = 0
  For i = 0 To totalnum
    avdis2 = 0
    For j = 0 To totalnum
      pt1 = Rhino.pointcoordinates(points(i))
      pt2 = Rhino.pointcoordinates(points(j))
      avdis2 = avdis2 + Rhino.distance (pt1,pt2)
    Next
    avdis = avdis + avdis2
  Next
  avdis = avdis / ( totalnum * totalnum ) 
  averagedis = avdis
  
End Function


'========================================================================'
'MAIN SUB ---------------------------------------------------------------

Function flock (massTarget, massAlignment, massSeparation, massCohesion, separationpercentage, maxrandomvector, massDetection, targetptinterval, keeppoints,drawlines,drawcurves,drawsurface , pickcurve, drawtargetpt, loftsteps, loftroute)
  
Dim arrpoints, arrmultipts, arrvector  
Dim totalnum, i,j, m
Dim alignmentvector, separationvector, cohesionvector, vectoraverage, vectorline, targetvector
Dim counter, maxcounter
Dim arrNewpoints, oldPoint, newPoint, newVector, disrange, separaterange
Dim strTemp
Dim targetpt, targetnum()
Dim strMessage, arrroute, arrcurvept

'Parameters'
'====================='

massTarget=1
massAlignment=5
massSeparation=4
massCohesion=1
separationpercentage=0.5 
maxrandomvector = 1
massDetection =2
targetptinterval = 20
'keeppoints = False
drawlines = True
drawcurves = True
'drawsurface = True 
pickcurve=False
drawtargetpt = True
drawcurrenttarget = False
loftsteps = False
loftroute = True
moveup = Array (0,80,0)

'====================='

createpoints  
    
arrpoints = Rhino.GetObjects ("selec points",1)
totalnum = UBound(arrpoints)
disrange = averagedis (arrpoints, totalnum) * massDetection
separaterange = disrange*separationpercentage

If pickcurve = False Then
  targetpt = Rhino.GetPoints()   
Else 
  arrcurvept = curvept(targetptinterval)
  targetpt = arrcurvept
End If

If drawtargetpt = True Then
Rhino.AddPoints targetpt
End If
 
ReDim arrmultipts(totalnum,totalnum)
ReDim targetnum(totalnum)
ReDim currenttarget(totalnum)
ReDim oldrelation (totalnum)

For i = 0 To totalnum
  targetnum(i) = 1
  pt = Rhino.pointcoordinates(arrpoints(i))
  currenttarget(i) = Targetrelative(pt,targetpt,0)
  Next


arrvector = randomvector (totalnum, maxrandomvector) 'random vector'
arrmultipts = pointsdistance (arrpoints, totalnum, disrange)  


'MOVEMENT LOOP------------------------------------------------
counter = 0   
maxcounter = Rhino.GetReal("Times to Move Points:")'Determine number of steps
ReDim arrroutept (totalnum, maxcounter)

If maxcounter > 0 Then  'Loop begin
For counter = 0 To maxcounter
  arrmultipts = pointsdistance (arrpoints, totalnum, disrange)
  alignmentvector = alignment(arrmultipts, arrvector, totalnum)
  separationvector = separation(arrpoints, arrmultipts, totalnum, disrange, separaterange)
  cohesionvector = cohesion(arrpoints, arrmultipts, totalnum)
  targetvector = targetself(arrpoints, totalnum, targetpt, targetnum, disrange, currenttarget, drawcurrenttarget)
  ReDim averagevector(totalnum)

For i = 0 To totalnum
  averagevector (i) = Array (0,0,0)
  targetvector (i) = Rhino.vectorscale (targetvector (i), massTarget)
  alignmentvector (i) = Rhino.vectorscale (alignmentvector (i), massAlignment)
  separationvector (i) = Rhino.vectorscale (separationvector (i), massSeparation)
  cohesionvector (i) = Rhino.vectorscale (cohesionvector (i), massCohesion)
  
  averagevector(i) = Rhino.vectoradd (averagevector(i),targetvector (i))
  averagevector(i) = Rhino.vectoradd (averagevector(i),alignmentvector (i))
  averagevector(i) = Rhino.vectoradd (averagevector(i),separationvector (i))
  averagevector(i) = Rhino.vectoradd (averagevector(i),cohesionvector (i))
Next

'Move Points by one step from vector
  For i = 0 To totalnum
    
    oldPoint = Rhino.pointcoordinates(arrpoints(i))
    newPoint = Rhino.vectoradd(oldPoint, arrvector(i))
    
'Caculate New velocity
'define new vector as (Initial Vector - (Initial Vector - Target Vector)*magnitude) 
    
    newVector = Rhino.vectorsubtract (arrvector(i), averagevector (i))
    newVector = Rhino.vectorscale (newVector, 0.2)
    newVector = Rhino.vectorsubtract ( arrvector(i), newVector)
    
    If keeppoints = False Then
    deletePoint = arrpoints(i)
    Rhino.DeleteObject deletePoint
    End If
    
    
    strTemp = Rhino.AddPoint (newPoint)
    arrroutept(i,counter) = newPoint
    'Rhino.Addpoint(arrroute(i,counter))
    
    arrpoints(i) = strTemp
    arrvector (i) = newVector
  Next
  
    If drawlines = True Then
    vectorline = draw(arrpoints, arrvector, totalnum) 'Draw Path'
    End If
    
 Next

'Print all paraments & surface-------------------------------
strMessage = "Detection Raidius = " & disrange & vbNewLine & "Separation Radius = " & separaterange & vbNewLine & "  " & vbNewLine &  "Weight:" & vbNewLine & "ALIGNMENT = " & massALIGNMENT & vbNewLine & "SEPARATION = " & massSEPARATION & vbNewLine & "COHESION = " & massCOHESION & vbNewLine & "TARGET = " & massTARGET            
Rhino.print strMessage

Dim routepoint()

If (loftroute = True) Then
ReDim routecurve(totalnum)
For i = 0 To totalnum
  ReDim routepoint(maxcounter)
    For j = 0 To maxcounter
      routepoint(j) = arrroutept(i,j)
    Next
    routecurve(i) = Rhino.AddInterpCurve (routepoint)
Next

  If drawsurface = True Then
  Rhino.AddLoftSrf routecurve
  End If
  
End If

If (loftsteps = True) Then
ReDim routecurve(maxcounter)
For i = 0 To maxcounter
  ReDim routepoint(totalnum)
    For j = 0 To totalnum
      routepoint(j) = arrroutept(j,i)
      routepoint(j) = Rhino.Vectoradd (routepoint(j), moveup)
    Next
    routecurve(i) = Rhino.AddInterpCurve (routepoint)
Next

  If drawsurface = True Then
  Rhino.AddLoftSrf routecurve
  End If
  
End If 
  
  


End If
End Function


Sub flying
  
 Call flock (1,1,0.2,1,0.5 , 0, 2, 10,  False,  False,  False,  True ,True,  False, True, True)

End Sub

flying