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
Dim arrPtdiv()
Dim createdCrvs()
ReDim Preserve createdCrvs(0) : createdCrvs(0) = sCrv
For i = 0 To 6
Dim aEditpts : aEditpts = Rhino.CurveEditPoints (sCrv)
ReDim aptsCrvs(Ubound(aEditpts))
For j = 0 To Ubound(aEditpts)
Dim offsetdist: offsetdist = arbitraryValue(0, 10*j) +1
If i Mod 3 = 0 Then
If j Mod 2 = 0 Then
‘offsetdist < Ubound(aEditpts) Then
offsetdist=0
End If
If j Mod 2 =1 Then
offsetdist = offsetdist+1
End If
End If
Dim var
If i Mod 2 = 0 Then
var = 1
Else
var = 0
End If
aptsCrvs(j) = array(aEditpts(j)(0) + offsetdist,aEditpts(j)(1),aEditpts(j)(2)-20*(-1)^(var))
Next
‘If i <> 0 Then Call rhino.AddInterpCurve(aptsCrvs)
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_lines arrPtdiv
Add_lines1 arrPtdiv,createdCrvs
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))
Dim crvCurv : crvCurv = Rhino.CurveCurvature(sCrv,t)(3)
‘Rhino.AddTextDot crvCurv & t,arrCrvEpt(i)
‘Rhino.Print “Point ” & i & “of ” & Ubound(arrCrvEpt)
‘ReDim Preserve arrPtdiv(i)
‘arrPtdiv(i) = Rhino.AddPoint(arrCrvEPt(i))
Next
Else
Rhino.Print “it is not an array”
End If
‘Div_curvature = arrPtdiv
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
For i = 1 To Ubound(arrPtdiv(counter))
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))
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
0 responses so far ↓
There are no comments yet...Kick things off by filling out the form below.