AN_Meander Creator

Option Explicit
‘Script written by Adolfo Nadal
‘Script copyrighted by Archi-o-logics
‘Script version Friday, October 17, 2008 6:01:58 PM

Call Main()
Sub Main()
 Dim sCrv : sCrv = rhino.GetObject(“pick crv”, 4)
 Dim i, j,l
 Dim arrPtdiv()
 
 Dim createdCrvs()
 ReDim Preserve createdCrvs(0) : createdCrvs(0) = sCrv
 Dim aEditpts
 
 Rhino.EnableRedraw False
 
 For i = 0 To 100
  aEditpts = Rhino.CurveEditPoints(sCrv)
  ReDim aptsCrvs(Ubound(aEditpts))
  
  For j = 0 To Ubound(aEditpts)
   Dim offsetdist: offsetdist = arbitraryValue(0, 10*i^(0.5)) +1
   If i Mod 2 =0 Then
    If j Mod 3= 0 Then
     offsetdist = 0
    End If   
   End If
   
   Dim var
   ‘Dim ZVar: ZVar = 0
   If j<> 0 And j<>Ubound(aEditPts) Then
    ‘ZVar = 4*i+1   
    If i Mod 2 = 0 Then
     var = 1
    Else
     var = 0
    End If
   End If
   
   If j=0 Or j=Ubound(aEditpts) Then
    offsetdist = offsetdist/2
   End If 
   aptsCrvs(j) = array(aEditpts(j)(0) + offsetdist,aEditpts(j)(1),aEditpts(j)(2))   
  Next
  ‘—————————————————
  If i <> 0 Then
   Dim sCrv2 : sCrv2 = rhino.AddInterpCurve(aptsCrvs)
   ReDim Preserve arrPtdiv(i-1)
   arrPtdiv(i-1) = Div_curvature(sCrv2)
   Call rhino.ObjectColor(sCrv2, rgb(255/10*i, 0, 255/10*i))
   ReDim Preserve createdCrvs(i) : createdCrvs(i) = sCrv2
   sCrv = sCrv2
  End If
 Next
 
 Add_lines1 arrPtdiv,createdCrvs
 
 Rhino.EnableRedraw False
 
End Sub

Function arbitraryValue(min, max)
 Randomize
 arbitraryValue = min + (max – min) * Rnd
End Function
Function Div_curvature(sCrv)
 Rhino.EnableRedraw False
 Dim i
 Dim arrPtdiv()
 
 Dim sCrv3 : sCrv3 = Rhino.CopyObject(sCrv)
 
 Dim arrCrv : arrCrv = Rhino.ConvertCurveToPolyline(sCrv3,40,0.08)
 Dim arrCrvEPt : arrCrvEPt = Rhino.CurveEditPoints(arrCrv)
 
 Dim t
 Dim crvDom : crvDom = Rhino.CurveDomain(sCrv) 
 ‘Dim ACurv: ACurv = AverageCurv(t,sCrv,crvDom)
 
 If IsArray(arrCrvEPt) Then
  For i = 0 To Ubound(arrCrvEPt)
   t = Rhino.CurveClosestPoint(sCrv,arrCrvEpt(i))
  Next
 Else
  Rhino.Print “it is not an array”
 End If 
 Div_curvature = arrCrvEPt
 Rhino.DeleteObjects(array(sCrv3,arrCrv))
 Rhino.EnableRedraw True
End Function
Function add_lines(arrPtdiv)
 Rhino.EnableRedraw False
 Dim i, j
 Dim counter : counter = 0
 
 Do While (counter+3<=Ubound(arrPtdiv)+1)
  If Ubound(arrPtdiv(counter))<Ubound(arrPtdiv(counter+2)) Then
   For i = 1 To Ubound(arrPtdiv(counter))
    Rhino.AddLine arrPtdiv(counter)(i),arrPtdiv(counter+2)(i-1)
   Next  
  Else
   For i = 1 To Ubound(arrPtdiv(counter+2))
    Rhino.AddLine arrPtdiv(counter)(i),arrPtdiv(counter+2)(i-1)
   Next
  End If
  counter = counter +3
 Loop
 Rhino.EnableRedraw True
End Function
Function add_lines1(arrPtdiv, createdCrvs)
 Rhino.EnableRedraw False
 Dim i, j
 Dim counter : counter = 0
 
 Do While (counter+3<=Ubound(arrPtdiv)+1)
  If Ubound(arrPtdiv(counter))<Ubound(arrPtdiv(counter+2)) Then
   ‘this controls the height of the curve to make more “crazy things”
   createdCrvs(counter+2) = Rhino.MoveObject(createdCrvs(counter+2),array(0,0,0),array(0,0,-10))
   change_certain_zs createdCrvs(counter+2),counter
   For i = 1 To Ubound(arrPtdiv(counter))
    ‘createdCrvs(counter+2) = Rhino.MoveObject(createdCrvs(counter+2),array(0,0,0),array(0,0,-50))
    Rhino.AddLine arrPtdiv(counter)(i),Rhino.EvaluateCurve(createdCrvs(counter+2),Rhino.CurveClosestPoint(createdCrvs(counter+2),arrPtdiv(counter)(i)))
   Next  
  Else
   For i = 1 To Ubound(arrPtdiv(counter+2))
    ‘createdCrvs(counter+2)=Rhino.MoveObject(createdCrvs(counter+2),array(0,0,0),array(0,0,-50))
    Rhino.AddLine arrPtdiv(counter)(i),Rhino.EvaluateCurve(createdCrvs(counter+2),Rhino.CurveClosestPoint(createdCrvs(counter+2),arrPtdiv(counter)(i)))
   Next
  End If
  counter = counter +3
 Loop
 Rhino.EnableRedraw True
End Function
Function AverageCurv(t,strCrv,crvDom)
 Dim aveCurv : aveCurv = 0
 For t=0 To crvDom(1)+1e-9 Step (crvDom(1)-CrvDom(0))/100
  Dim curv : curv = Rhino.CurveCurvature(strCrv,t)(3)
  If isNull (curv) Then
   curv=0
  End If
  aveCurv = aveCurv + curv
 Next
 Rhino.Print aveCurv/100
 
End Function
Function Change_certain_zs (createdCrv,counter)
 Dim EditPts : EditPts = Rhino.CurveEditPoints(createdCrv,False)
 Dim m
 For m = 0 To Ubound(EditPts)
  If counter Mod 2 = 0 Then
   If m Mod 2 = 0 Then
    EditPts(m)(2) = EditPts(m)(2)+10
    ‘Rhino.AddTextDot Rhino.Pt2Str(EditPts(m)),EditPts(m)
   End If
  End If
  If counter Mod 2 =1 Then
   If m Mod 2 = 0 Then
    EditPts(m)(2) = EditPts(m)(2)+10
    ‘Rhino.AddTextDot “counter+2 mod 2 =1” & Rhino.Pt2Str(EditPts(m)),EditPts(m)
   End If   
  End If  
 Next
 createdCrv = Rhino.AddInterpCurve(EditPts)
 Change_certain_zs = createdCrv
End Function

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s