Parameterization Equations
plotting points
sine
A is called the amplitude (the height of each peak above the baseline)
C is the vertical offset (height of the baseline)
P is the period or wavelength (the length of each cycle)
w is the angular frequency, given by = 2/P
a is the phase shift (the horizontal offset of the basepoint; where the curve crosses the baseline as it ascends)
Option Explicit
'Sine curve
Sub Main()
Dim PI : PI = 3.14159265
Dim dblA : dblA = Rhino.GetReal ("type the amplitude", 1)
Dim dblC : dblC = Rhino.GetReal ("type the vertical offset", 2)
Dim dblP : dblP = Rhino.GetReal ("type the period", 2)
Dim dblw : dblw = 2*PI/dblP
Dim dblAlfa : dblAlfa = Rhino.GetReal ("type the phase shift", .3)
Dim dblLength : dblLength = Rhino.GetReal ("type the length", 10)
Dim dblRes : dblRes = Rhino.GetReal ("type the resolution", 100)
Dim dblStep : dblStep = dblLength/dblRes
Dim x, y, z
Dim rads
Dim i
For i=0 To dblLength Step dblStep
x = i
y = 0
z = dblA*(sin(dblw*(x-dblAlfa))) + dblC
Call Rhino.AddPoint(array(x,y,z))
Next
End Sub
Call Main()
'Sine curve
Sub Main()
Dim PI : PI = 3.14159265
Dim dblA : dblA = Rhino.GetReal ("type the amplitude", 1)
Dim dblC : dblC = Rhino.GetReal ("type the vertical offset", 2)
Dim dblP : dblP = Rhino.GetReal ("type the period", 2)
Dim dblw : dblw = 2*PI/dblP
Dim dblAlfa : dblAlfa = Rhino.GetReal ("type the phase shift", .3)
Dim dblLength : dblLength = Rhino.GetReal ("type the length", 10)
Dim dblRes : dblRes = Rhino.GetReal ("type the resolution", 100)
Dim dblStep : dblStep = dblLength/dblRes
Dim x, y, z
Dim rads
Dim i
For i=0 To dblLength Step dblStep
x = i
y = 0
z = dblA*(sin(dblw*(x-dblAlfa))) + dblC
Call Rhino.AddPoint(array(x,y,z))
Next
End Sub
Call Main()
clifford attractor
Option explicit
Call Main()
Sub Main()
Dim numPts: numPts = 5000
Dim Xpt, Ypt, Zpt, x, y, z
Dim arrPoint
Dim a,b,c,d
''random init
a = randBetween(2.24,-1.7)
b = randBetween(2.24,-1.7)
c = randBetween(2.24,-1.7)
d = randBetween(2.24,-1.7)
''init x,y
x = 0
y = 0
z = 0
Dim i
ReDim arrPts(numPts)
For i=0 To numPts
xPt = Sin(a * y) - z * Cos(b * x)
yPt = z * Sin(c * x) - Cos(d * y)
zPt = Sin(x)
x = xPt
y = yPt
z = zPt
arrPoint = array(xPt, yPt, zPt)
arrPts(i) = arrPoint
Next
Call rhino.addPointCloud (arrPts)
End Sub
Function randBetween (upper, lower)
randBetween = ((upper - lower) * Rnd + lower)
End Function
Call Main()
Sub Main()
Dim numPts: numPts = 5000
Dim Xpt, Ypt, Zpt, x, y, z
Dim arrPoint
Dim a,b,c,d
''random init
a = randBetween(2.24,-1.7)
b = randBetween(2.24,-1.7)
c = randBetween(2.24,-1.7)
d = randBetween(2.24,-1.7)
''init x,y
x = 0
y = 0
z = 0
Dim i
ReDim arrPts(numPts)
For i=0 To numPts
xPt = Sin(a * y) - z * Cos(b * x)
yPt = z * Sin(c * x) - Cos(d * y)
zPt = Sin(x)
x = xPt
y = yPt
z = zPt
arrPoint = array(xPt, yPt, zPt)
arrPts(i) = arrPoint
Next
Call rhino.addPointCloud (arrPts)
End Sub
Function randBetween (upper, lower)
randBetween = ((upper - lower) * Rnd + lower)
End Function
animated:
Option explicit
Call Main()
Sub Main()
Dim numPts: numPts = 1000
Dim Xpt, Ypt, Zpt, x, y, z
Dim arrPoint
Dim a,b,c,d
''random init
a = randBetween(2.24,-1.7)
b = randBetween(2.24,-1.7)
c = randBetween(2.24,-1.7)
d = randBetween(2.24,-1.7)
''init x,y
x = 0 : y = 0 : z = 0
Dim i
ReDim arrPts(numPts)
For a = -4 To 4 Step .01
For i=0 To numPts
xPt = Sin(a * y) - z * Cos(b * x)
yPt = z * Sin(c * x) - Cos(d * y)
zPt = Sin(x)
x = xPt
y = yPt
z = zPt
arrPoint = array(xPt, yPt, zPt)
arrPts(i) = arrPoint
Next
If a>-4 Then
Call rhino.DeleteObject (strPointCloud)
End If
Dim strPointCloud : strPointCloud = rhino.addPointCloud (arrPts)
Next
End Sub
Function randBetween (upper, lower)
randBetween = ((upper - lower) * Rnd + lower)
End Function
Call Main()
Sub Main()
Dim numPts: numPts = 1000
Dim Xpt, Ypt, Zpt, x, y, z
Dim arrPoint
Dim a,b,c,d
''random init
a = randBetween(2.24,-1.7)
b = randBetween(2.24,-1.7)
c = randBetween(2.24,-1.7)
d = randBetween(2.24,-1.7)
''init x,y
x = 0 : y = 0 : z = 0
Dim i
ReDim arrPts(numPts)
For a = -4 To 4 Step .01
For i=0 To numPts
xPt = Sin(a * y) - z * Cos(b * x)
yPt = z * Sin(c * x) - Cos(d * y)
zPt = Sin(x)
x = xPt
y = yPt
z = zPt
arrPoint = array(xPt, yPt, zPt)
arrPts(i) = arrPoint
Next
If a>-4 Then
Call rhino.DeleteObject (strPointCloud)
End If
Dim strPointCloud : strPointCloud = rhino.addPointCloud (arrPts)
Next
End Sub
Function randBetween (upper, lower)
randBetween = ((upper - lower) * Rnd + lower)
End Function
drawing curves
casteljau’s algorithm
Option Explicit
Call Main()
Sub Main()
Dim strPolyline : strPolyline = Rhino.GetObject("select a polyline with 3 segments to draw a nurbs from", 4)
If Not Rhino.IsPolyline(strPolyline) Then
Call Rhino.Print("this is not a polyline")
Exit Sub
End If
Dim arrPolyPts : arrPolyPts = Rhino.PolylineVertices(strPolyline )
If Not Ubound(arrPolyPts)=3 Then
Call Rhino.Print("this polyline doesn't have 3 segments")
Exit Sub
End If
Dim intRes : intRes = Rhino.GetInteger("input the resolution of the subdivision", 20)
Dim arrLines(2)
Dim i
For i=0 To 2
Dim arrPolyPt0 : arrPolyPt0 = arrPolyPts(i)
Dim arrPolyPt1 : arrPolyPt1 = arrPolyPts(i+1)
arrLines(i) = Rhino.AddLine(arrPolyPt0, arrPolyPt1)
'call Rhino.Print "domain(0):" & rhino.CurveDomain(arrLines(i))(0) & " , domain(1):" & rhino.CurveDomain(arrLines(i))(1)
Next
Dim arrDivPts0 : arrDivPts0 = Rhino.DivideCurve(arrLines(0), intRes)
Dim arrDivPts1 : arrDivPts1 = Rhino.DivideCurve(arrLines(1), intRes)
Dim arrDivPts2 : arrDivPts2 = Rhino.DivideCurve(arrLines(2), intRes)
For i=0 To intRes
Dim strSubLine01 : strSubLine01 = Rhino.AddLine(arrDivPts0(i),arrDivPts1(i))
Dim arrSub01Div : arrSub01Div = Rhino.DivideCurve(strSubLine01,intRes)
Dim strSubLine12 : strSubLine12 = Rhino.AddLine(arrDivPts1(i),arrDivPts2(i))
Dim arrSub12Div : arrSub12Div = Rhino.DivideCurve(strSubLine12,intRes)
Dim strSubLine : strSubLine = Rhino.AddLine(arrSub01Div(i),arrSub12Div(i))
Dim arrSubDiv, arrOldSDPt
If i>0 Then
arrSubDiv = Rhino.DivideCurve(strSubLine,intRes)
Dim strLine : strLine = Rhino.AddLine(arrSubDiv(i), arrOldSDPt)
arrOldSDPt = arrSubDiv(i)
Dim strPoint : strPoint = Rhino.AddPoint(arrSubDiv(i))
Call Rhino.ObjectColor(strLine, RGB(255,0,0))
Call Rhino.DeleteObjects(array(strPoint, strSubLine01, strSubLine12, strSubLine))
Else
arrSubDiv = Rhino.DivideCurve(strSubLine,intRes)
arrOldSDPt = arrSubDiv(i)
Call Rhino.DeleteObjects(array(strSubLine01, strSubLine12, strSubLine))
End If
Next
Call Rhino.DeleteObjects(arrLines)
End Sub
Call Main()
Sub Main()
Dim strPolyline : strPolyline = Rhino.GetObject("select a polyline with 3 segments to draw a nurbs from", 4)
If Not Rhino.IsPolyline(strPolyline) Then
Call Rhino.Print("this is not a polyline")
Exit Sub
End If
Dim arrPolyPts : arrPolyPts = Rhino.PolylineVertices(strPolyline )
If Not Ubound(arrPolyPts)=3 Then
Call Rhino.Print("this polyline doesn't have 3 segments")
Exit Sub
End If
Dim intRes : intRes = Rhino.GetInteger("input the resolution of the subdivision", 20)
Dim arrLines(2)
Dim i
For i=0 To 2
Dim arrPolyPt0 : arrPolyPt0 = arrPolyPts(i)
Dim arrPolyPt1 : arrPolyPt1 = arrPolyPts(i+1)
arrLines(i) = Rhino.AddLine(arrPolyPt0, arrPolyPt1)
'call Rhino.Print "domain(0):" & rhino.CurveDomain(arrLines(i))(0) & " , domain(1):" & rhino.CurveDomain(arrLines(i))(1)
Next
Dim arrDivPts0 : arrDivPts0 = Rhino.DivideCurve(arrLines(0), intRes)
Dim arrDivPts1 : arrDivPts1 = Rhino.DivideCurve(arrLines(1), intRes)
Dim arrDivPts2 : arrDivPts2 = Rhino.DivideCurve(arrLines(2), intRes)
For i=0 To intRes
Dim strSubLine01 : strSubLine01 = Rhino.AddLine(arrDivPts0(i),arrDivPts1(i))
Dim arrSub01Div : arrSub01Div = Rhino.DivideCurve(strSubLine01,intRes)
Dim strSubLine12 : strSubLine12 = Rhino.AddLine(arrDivPts1(i),arrDivPts2(i))
Dim arrSub12Div : arrSub12Div = Rhino.DivideCurve(strSubLine12,intRes)
Dim strSubLine : strSubLine = Rhino.AddLine(arrSub01Div(i),arrSub12Div(i))
Dim arrSubDiv, arrOldSDPt
If i>0 Then
arrSubDiv = Rhino.DivideCurve(strSubLine,intRes)
Dim strLine : strLine = Rhino.AddLine(arrSubDiv(i), arrOldSDPt)
arrOldSDPt = arrSubDiv(i)
Dim strPoint : strPoint = Rhino.AddPoint(arrSubDiv(i))
Call Rhino.ObjectColor(strLine, RGB(255,0,0))
Call Rhino.DeleteObjects(array(strPoint, strSubLine01, strSubLine12, strSubLine))
Else
arrSubDiv = Rhino.DivideCurve(strSubLine,intRes)
arrOldSDPt = arrSubDiv(i)
Call Rhino.DeleteObjects(array(strSubLine01, strSubLine12, strSubLine))
End If
Next
Call Rhino.DeleteObjects(arrLines)
End Sub
sine curve drawn with interprCrv
option explicit
''Sin curve
Sub Main()
Dim PI : PI = 3.14159265
Dim dblA : dblA = Rhino.GetReal ("type the amplitude", 1)
Dim dblC : dblC = Rhino.GetReal ("type the vertical offset", 2)
Dim dblP : dblP = Rhino.GetReal ("type the period", 2)
Dim dblw : dblw = 2*PI/dblP
Dim dblAlfa : dblAlfa = Rhino.GetReal ("type the phase shift", .3)
Dim dblLength : dblLength = Rhino.GetReal ("type the length", 10)
Dim dblRes : dblRes = Rhino.GetReal ("type the resolution", 100)
Dim dblStep : dblStep = dblLength/dblRes
Dim x, y, z
ReDim arrPoints(-1)
Dim rads
Dim i
For i=0 To dblLength Step dblStep
x = i
y = 0
z = dblA*(sin(dblw*(x-dblAlfa))) + dblC
ReDim Preserve arrPoints(Ubound(arrPoints)+1)
arrPoints(Ubound(arrPoints)) = array(x,y,z)
Next
Call rhino.addInterpCurve (arrPoints)
End Sub
Call Main()
''Sin curve
Sub Main()
Dim PI : PI = 3.14159265
Dim dblA : dblA = Rhino.GetReal ("type the amplitude", 1)
Dim dblC : dblC = Rhino.GetReal ("type the vertical offset", 2)
Dim dblP : dblP = Rhino.GetReal ("type the period", 2)
Dim dblw : dblw = 2*PI/dblP
Dim dblAlfa : dblAlfa = Rhino.GetReal ("type the phase shift", .3)
Dim dblLength : dblLength = Rhino.GetReal ("type the length", 10)
Dim dblRes : dblRes = Rhino.GetReal ("type the resolution", 100)
Dim dblStep : dblStep = dblLength/dblRes
Dim x, y, z
ReDim arrPoints(-1)
Dim rads
Dim i
For i=0 To dblLength Step dblStep
x = i
y = 0
z = dblA*(sin(dblw*(x-dblAlfa))) + dblC
ReDim Preserve arrPoints(Ubound(arrPoints)+1)
arrPoints(Ubound(arrPoints)) = array(x,y,z)
Next
Call rhino.addInterpCurve (arrPoints)
End Sub
Call Main()
draw many sine curves with variation
option explicit
'Sin curve
Sub Main()
Dim PI : PI = 3.14159265
Dim dblA : dblA = Rhino.GetReal ("type the amplitude", 1)
Dim dblC : dblC = Rhino.GetReal ("type the vertical offset", 2)
Dim dblP : dblP = Rhino.GetReal ("type the period", 2)
Dim dblAlfa : dblAlfa = Rhino.GetReal ("type the phase shift", .3)
Dim dblLength : dblLength = Rhino.GetReal ("type the length", 10)
Dim dblRes : dblRes = Rhino.GetReal ("type the resolution", 100)
Dim intHowMany : intHowMany = Rhino.GetInteger("type how many crvs on y axis", 10)
Dim i
For i=0 To intHowMany
Call drawSine(dblA, dblC, dblP, dblAlfa, dblLength, dblRes, i)
Next
End Sub
Call Main()
Function drawSine(dblA, dblC, dblP, dblAlfa, dblLength, dblRes, int)
Dim dblw : dblw = 2*PI/dblP
Dim dblStep : dblStep = dblLength/dblRes
Dim x, y, z
ReDim arrPoints(-1)
Dim rads
Dim i
For i=0 To dblLength Step dblStep
x = i
y = int
z = dblA*(sin(dblw*(x-dblAlfa-(int*.2)))) + dblC
ReDim Preserve arrPoints(Ubound(arrPoints)+1)
arrPoints(Ubound(arrPoints)) = array(x,y,z)
Next
Call rhino.addInterpCurve (arrPoints)
End Function
'Sin curve
Sub Main()
Dim PI : PI = 3.14159265
Dim dblA : dblA = Rhino.GetReal ("type the amplitude", 1)
Dim dblC : dblC = Rhino.GetReal ("type the vertical offset", 2)
Dim dblP : dblP = Rhino.GetReal ("type the period", 2)
Dim dblAlfa : dblAlfa = Rhino.GetReal ("type the phase shift", .3)
Dim dblLength : dblLength = Rhino.GetReal ("type the length", 10)
Dim dblRes : dblRes = Rhino.GetReal ("type the resolution", 100)
Dim intHowMany : intHowMany = Rhino.GetInteger("type how many crvs on y axis", 10)
Dim i
For i=0 To intHowMany
Call drawSine(dblA, dblC, dblP, dblAlfa, dblLength, dblRes, i)
Next
End Sub
Call Main()
Function drawSine(dblA, dblC, dblP, dblAlfa, dblLength, dblRes, int)
Dim dblw : dblw = 2*PI/dblP
Dim dblStep : dblStep = dblLength/dblRes
Dim x, y, z
ReDim arrPoints(-1)
Dim rads
Dim i
For i=0 To dblLength Step dblStep
x = i
y = int
z = dblA*(sin(dblw*(x-dblAlfa-(int*.2)))) + dblC
ReDim Preserve arrPoints(Ubound(arrPoints)+1)
arrPoints(Ubound(arrPoints)) = array(x,y,z)
Next
Call rhino.addInterpCurve (arrPoints)
End Function
parameter on curve
Option Explicit
Call Main()
Sub Main()
Dim strObject, arrPoint, dblParam
strObject = Rhino.GetObject("Select a curve")
If Rhino.IsCurve(strObject) Then
arrPoint = Rhino.GetPointOnCurve(strObject, "Pick a test point")
If IsArray(arrPoint) Then
dblParam = Rhino.CurveClosestPoint(strObject, arrPoint)
Dim arrPtOnCrv : arrPtOnCrv = Rhino.EvaluateCurve(strObject, dblParam)
Call rhino.AddPoint (arrPtOnCrv)
Call rhino.AddLine(arrPoint, arrPtOnCrv)
End If
End If
End Sub
Call Main()
Sub Main()
Dim strObject, arrPoint, dblParam
strObject = Rhino.GetObject("Select a curve")
If Rhino.IsCurve(strObject) Then
arrPoint = Rhino.GetPointOnCurve(strObject, "Pick a test point")
If IsArray(arrPoint) Then
dblParam = Rhino.CurveClosestPoint(strObject, arrPoint)
Dim arrPtOnCrv : arrPtOnCrv = Rhino.EvaluateCurve(strObject, dblParam)
Call rhino.AddPoint (arrPtOnCrv)
Call rhino.AddLine(arrPoint, arrPtOnCrv)
End If
End If
End Sub
drawing surfaces
stepping a surface with points
Option Explicit
Call Main()
Sub Main()
Dim strSurface : strSurface = Rhino.GetObject("select a surface on which to draw", 8)
Dim intU : intU = Rhino.GetInteger("how many in U?", 10)
Dim intV : intV = Rhino.GetInteger("how many in V?", 10)
Call DivideSurface (strSurface, array(intU,intV))
End Sub
Function DivideSurface (strSrf, arrCount)
DivideSurface = Null
If Not Rhino.IsSurface(strSrf) Then Exit Function
If Not IsNumeric(arrCount(0)) Then Exit Function
If Not IsNumeric(arrCount(1)) Then Exit Function
arrCount(0) = CInt(arrCount(0))
arrCount(1) = CInt(arrCount(1))
Dim arrDomainU : arrDomainU = Rhino.SurfaceDomain(strSrf, 0)
Dim dblUStep : dblUStep = (arrDomainU(1)-arrDomainU(0))/arrCount(0)
Dim arrDomainV : arrDomainV = Rhino.SurfaceDomain(strSrf, 1)
Dim dblVStep : dblVStep = (arrDomainV(1)-arrDomainV(0))/arrCount(1)
Dim uCount, vCount
For uCount=arrDomainU(0) To arrDomainU(1) Step dblUStep
For vCount=arrDomainV(0) To arrDomainV(1) Step dblVStep
Dim arrPoint : arrPoint = Rhino.EvaluateSurface(strSrf, array(uCount,vCount))
Call rhino.AddPoint(arrPoint)
Next
Next
End Function
Call Main()
Sub Main()
Dim strSurface : strSurface = Rhino.GetObject("select a surface on which to draw", 8)
Dim intU : intU = Rhino.GetInteger("how many in U?", 10)
Dim intV : intV = Rhino.GetInteger("how many in V?", 10)
Call DivideSurface (strSurface, array(intU,intV))
End Sub
Function DivideSurface (strSrf, arrCount)
DivideSurface = Null
If Not Rhino.IsSurface(strSrf) Then Exit Function
If Not IsNumeric(arrCount(0)) Then Exit Function
If Not IsNumeric(arrCount(1)) Then Exit Function
arrCount(0) = CInt(arrCount(0))
arrCount(1) = CInt(arrCount(1))
Dim arrDomainU : arrDomainU = Rhino.SurfaceDomain(strSrf, 0)
Dim dblUStep : dblUStep = (arrDomainU(1)-arrDomainU(0))/arrCount(0)
Dim arrDomainV : arrDomainV = Rhino.SurfaceDomain(strSrf, 1)
Dim dblVStep : dblVStep = (arrDomainV(1)-arrDomainV(0))/arrCount(1)
Dim uCount, vCount
For uCount=arrDomainU(0) To arrDomainU(1) Step dblUStep
For vCount=arrDomainV(0) To arrDomainV(1) Step dblVStep
Dim arrPoint : arrPoint = Rhino.EvaluateSurface(strSrf, array(uCount,vCount))
Call rhino.AddPoint(arrPoint)
Next
Next
End Function
stepping a surface to make a diagrid
Option Explicit
Call Main()
Sub Main()
Dim strSurface : strSurface = Rhino.GetObject("select a surface on which to draw", 8)
Dim intU : intU = Rhino.GetInteger("how many in U?", 6)
Dim intV : intV = Rhino.GetInteger("how many in V?", 6)
Call DivideSurface (strSurface, array(intU,intV))
End Sub
Function DivideSurface (strSrf, arrCount)
DivideSurface = Null
If Not Rhino.IsSurface(strSrf) Then Exit Function
If Not IsNumeric(arrCount(0)) Then Exit Function
If Not IsNumeric(arrCount(1)) Then Exit Function
arrCount(0) = CInt(arrCount(0))
arrCount(1) = CInt(arrCount(1))
Dim arrDomainU : arrDomainU = Rhino.SurfaceDomain(strSrf, 0)
Dim dblUStep : dblUStep = (arrDomainU(1)-arrDomainU(0))/arrCount(0)
Dim arrDomainV : arrDomainV = Rhino.SurfaceDomain(strSrf, 1)
Dim dblVStep : dblVStep = (arrDomainV(1)-arrDomainV(0))/arrCount(1)
Dim uCount, vCount, count : count = 0
Dim uIntCount : uIntCount = 0
ReDim arrPoints(-1)
ReDim arrAllPts(arrCount(0),arrCount(1))
For uCount=arrDomainU(0) To arrDomainU(1) Step dblUStep
Dim vIntCount : vIntCount = 0
For vCount=arrDomainV(0) To arrDomainV(1) Step dblVStep
Dim arrPoint : arrPoint = Rhino.EvaluateSurface(strSrf, array(uCount,vCount))
arrAllPts(uIntCount,vIntCount) = arrPoint
'Call rhino.AddTextDot(uIntCount & "," & vIntCount, arrPoint)
Dim strLine0, strLine1
If uIntCount Mod 2 = 0 Then
If vIntCount Mod 2 = 0 Then
If uIntCount>1 And vIntCount>1 And vIntCount<arrCount(1) Then
Call Rhino.AddSrfPt (array(arrAllPts(uIntCount,vIntCount),arrAllPts(uIntCount-1,vIntCount+1),_
arrAllPts(uIntCount-2,vIntCount),arrAllPts(uIntCount-1,vIntCount-1)))
End If
If uIntCount>1 And vIntCount=0 Then
strLine0 = rhino.Addline (arrAllPts(uIntCount,vIntCount),arrAllPts(uIntCount-1,vIntCount+1))
strLine1 = rhino.Addline (arrAllPts(uIntCount-2,vIntCount),arrAllPts(uIntCount-1,vIntCount+1))
Call Rhino.AddLoftSrf (array(strLine1,strLine0))
Call Rhino.DeleteObjects(array(strLine0,strLine1))
End If
If uIntCount>1 And vIntCount=arrCount(1) Then
strLine0 = rhino.Addline (arrAllPts(uIntCount-1,vIntCount-1),arrAllPts(uIntCount,vIntCount))
strLine1 = rhino.Addline (arrAllPts(uIntCount-1,vIntCount-1),arrAllPts(uIntCount-2,vIntCount))
Call Rhino.AddLoftSrf (array(strLine1,strLine0))
Call Rhino.DeleteObjects(array(strLine0,strLine1))
End If
If uIntCount=arrCount(0) And vIntCount>1 Then
strLine0 = rhino.Addline (arrAllPts(uIntCount-1,vIntCount-1),arrAllPts(uIntCount,vIntCount))
strLine1 = rhino.Addline (arrAllPts(uIntCount-1,vIntCount-1),arrAllPts(uIntCount,vIntCount-2))
Call Rhino.AddLoftSrf (array(strLine0,strLine1))
Call Rhino.DeleteObjects(array(strLine0,strLine1))
End If
End If
Else
If vIntCount Mod 2 = 1 Then
If uIntCount>2 And vIntCount>=1 And vIntCount<arrCount(1) Then
Call Rhino.AddSrfPt (array(arrAllPts(uIntCount,vIntCount),arrAllPts(uIntCount-1,vIntCount+1),_
arrAllPts(uIntCount-2,vIntCount),arrAllPts(uIntCount-1,vIntCount-1)))
End If
If uIntCount>2 And vIntCount=arrCount(1) Then
strLine0 = rhino.Addline (arrAllPts(uIntCount,vIntCount),arrAllPts(uIntCount-1,vIntCount-1))
strLine1 = rhino.Addline (arrAllPts(uIntCount-2,vIntCount),arrAllPts(uIntCount-1,vIntCount-1))
Call Rhino.AddLoftSrf (array(strLine0,strLine1))
Call Rhino.DeleteObjects(array(strLine0,strLine1))
End If
If uIntCount=1 And vIntCount<arrCount(1) Then
strLine0 = rhino.Addline (arrAllPts(uIntCount,vIntCount),arrAllPts(uIntCount-1,vIntCount+1))
strLine1 = rhino.Addline (arrAllPts(uIntCount,vIntCount),arrAllPts(uIntCount-1,vIntCount-1))
Call Rhino.AddLoftSrf (array(strLine1,strLine0))
Call Rhino.DeleteObjects(array(strLine0,strLine1))
End If
If uIntCount=1 And vIntCount=arrCount(1) Then
Call Rhino.AddSrfPt (array(arrAllPts(uIntCount-1,vIntCount),arrAllPts(uIntCount-1,vIntCount-1),_
arrAllPts(uIntCount,vIntCount),arrAllPts(uIntCount-1,vIntCount)))
End If
If uIntCount=arrCount(0) And vIntCount>2 Then
strLine0 = rhino.Addline (arrAllPts(uIntCount,vIntCount),arrAllPts(uIntCount-1,vIntCount-1))
strLine1 = rhino.Addline (arrAllPts(uIntCount,vIntCount-2),arrAllPts(uIntCount-1,vIntCount-1))
Call Rhino.AddLoftSrf (array(strLine1,strLine0))
Call Rhino.DeleteObjects(array(strLine0,strLine1))
End If
If uIntCount=arrCount(0) And vIntCount=1 Then
Call Rhino.AddSrfPt (array(arrAllPts(uIntCount,vIntCount-1),arrAllPts(uIntCount,vIntCount),_
arrAllPts(uIntCount-1,vIntCount-1),arrAllPts(uIntCount,vIntCount-1)))
End If
End If
End If
vIntCount = vIntCount + 1
Next
uIntCount = uIntCount + 1
Next
End Function
Call Main()
Sub Main()
Dim strSurface : strSurface = Rhino.GetObject("select a surface on which to draw", 8)
Dim intU : intU = Rhino.GetInteger("how many in U?", 6)
Dim intV : intV = Rhino.GetInteger("how many in V?", 6)
Call DivideSurface (strSurface, array(intU,intV))
End Sub
Function DivideSurface (strSrf, arrCount)
DivideSurface = Null
If Not Rhino.IsSurface(strSrf) Then Exit Function
If Not IsNumeric(arrCount(0)) Then Exit Function
If Not IsNumeric(arrCount(1)) Then Exit Function
arrCount(0) = CInt(arrCount(0))
arrCount(1) = CInt(arrCount(1))
Dim arrDomainU : arrDomainU = Rhino.SurfaceDomain(strSrf, 0)
Dim dblUStep : dblUStep = (arrDomainU(1)-arrDomainU(0))/arrCount(0)
Dim arrDomainV : arrDomainV = Rhino.SurfaceDomain(strSrf, 1)
Dim dblVStep : dblVStep = (arrDomainV(1)-arrDomainV(0))/arrCount(1)
Dim uCount, vCount, count : count = 0
Dim uIntCount : uIntCount = 0
ReDim arrPoints(-1)
ReDim arrAllPts(arrCount(0),arrCount(1))
For uCount=arrDomainU(0) To arrDomainU(1) Step dblUStep
Dim vIntCount : vIntCount = 0
For vCount=arrDomainV(0) To arrDomainV(1) Step dblVStep
Dim arrPoint : arrPoint = Rhino.EvaluateSurface(strSrf, array(uCount,vCount))
arrAllPts(uIntCount,vIntCount) = arrPoint
'Call rhino.AddTextDot(uIntCount & "," & vIntCount, arrPoint)
Dim strLine0, strLine1
If uIntCount Mod 2 = 0 Then
If vIntCount Mod 2 = 0 Then
If uIntCount>1 And vIntCount>1 And vIntCount<arrCount(1) Then
Call Rhino.AddSrfPt (array(arrAllPts(uIntCount,vIntCount),arrAllPts(uIntCount-1,vIntCount+1),_
arrAllPts(uIntCount-2,vIntCount),arrAllPts(uIntCount-1,vIntCount-1)))
End If
If uIntCount>1 And vIntCount=0 Then
strLine0 = rhino.Addline (arrAllPts(uIntCount,vIntCount),arrAllPts(uIntCount-1,vIntCount+1))
strLine1 = rhino.Addline (arrAllPts(uIntCount-2,vIntCount),arrAllPts(uIntCount-1,vIntCount+1))
Call Rhino.AddLoftSrf (array(strLine1,strLine0))
Call Rhino.DeleteObjects(array(strLine0,strLine1))
End If
If uIntCount>1 And vIntCount=arrCount(1) Then
strLine0 = rhino.Addline (arrAllPts(uIntCount-1,vIntCount-1),arrAllPts(uIntCount,vIntCount))
strLine1 = rhino.Addline (arrAllPts(uIntCount-1,vIntCount-1),arrAllPts(uIntCount-2,vIntCount))
Call Rhino.AddLoftSrf (array(strLine1,strLine0))
Call Rhino.DeleteObjects(array(strLine0,strLine1))
End If
If uIntCount=arrCount(0) And vIntCount>1 Then
strLine0 = rhino.Addline (arrAllPts(uIntCount-1,vIntCount-1),arrAllPts(uIntCount,vIntCount))
strLine1 = rhino.Addline (arrAllPts(uIntCount-1,vIntCount-1),arrAllPts(uIntCount,vIntCount-2))
Call Rhino.AddLoftSrf (array(strLine0,strLine1))
Call Rhino.DeleteObjects(array(strLine0,strLine1))
End If
End If
Else
If vIntCount Mod 2 = 1 Then
If uIntCount>2 And vIntCount>=1 And vIntCount<arrCount(1) Then
Call Rhino.AddSrfPt (array(arrAllPts(uIntCount,vIntCount),arrAllPts(uIntCount-1,vIntCount+1),_
arrAllPts(uIntCount-2,vIntCount),arrAllPts(uIntCount-1,vIntCount-1)))
End If
If uIntCount>2 And vIntCount=arrCount(1) Then
strLine0 = rhino.Addline (arrAllPts(uIntCount,vIntCount),arrAllPts(uIntCount-1,vIntCount-1))
strLine1 = rhino.Addline (arrAllPts(uIntCount-2,vIntCount),arrAllPts(uIntCount-1,vIntCount-1))
Call Rhino.AddLoftSrf (array(strLine0,strLine1))
Call Rhino.DeleteObjects(array(strLine0,strLine1))
End If
If uIntCount=1 And vIntCount<arrCount(1) Then
strLine0 = rhino.Addline (arrAllPts(uIntCount,vIntCount),arrAllPts(uIntCount-1,vIntCount+1))
strLine1 = rhino.Addline (arrAllPts(uIntCount,vIntCount),arrAllPts(uIntCount-1,vIntCount-1))
Call Rhino.AddLoftSrf (array(strLine1,strLine0))
Call Rhino.DeleteObjects(array(strLine0,strLine1))
End If
If uIntCount=1 And vIntCount=arrCount(1) Then
Call Rhino.AddSrfPt (array(arrAllPts(uIntCount-1,vIntCount),arrAllPts(uIntCount-1,vIntCount-1),_
arrAllPts(uIntCount,vIntCount),arrAllPts(uIntCount-1,vIntCount)))
End If
If uIntCount=arrCount(0) And vIntCount>2 Then
strLine0 = rhino.Addline (arrAllPts(uIntCount,vIntCount),arrAllPts(uIntCount-1,vIntCount-1))
strLine1 = rhino.Addline (arrAllPts(uIntCount,vIntCount-2),arrAllPts(uIntCount-1,vIntCount-1))
Call Rhino.AddLoftSrf (array(strLine1,strLine0))
Call Rhino.DeleteObjects(array(strLine0,strLine1))
End If
If uIntCount=arrCount(0) And vIntCount=1 Then
Call Rhino.AddSrfPt (array(arrAllPts(uIntCount,vIntCount-1),arrAllPts(uIntCount,vIntCount),_
arrAllPts(uIntCount-1,vIntCount-1),arrAllPts(uIntCount,vIntCount-1)))
End If
End If
End If
vIntCount = vIntCount + 1
Next
uIntCount = uIntCount + 1
Next
End Function
draw circles on surface with gausian analysis
Option Explicit
Call Main()
Sub Main()
Dim strSurface : strSurface = Rhino.GetObject("select a surface on which to draw", 8)
Dim intU : intU = Rhino.GetInteger("how many in U?", 10)
Dim intV : intV = Rhino.GetInteger("how many in V?", 10)
Call DivideSurface (strSurface, array(intU,intV))
End Sub
Function DivideSurface (strSrf, arrCount)
DivideSurface = Null
If Not Rhino.IsSurface(strSrf) Then Exit Function
If Not IsNumeric(arrCount(0)) Then Exit Function
If Not IsNumeric(arrCount(1)) Then Exit Function
arrCount(0) = CInt(arrCount(0))
arrCount(1) = CInt(arrCount(1))
Dim arrDomainU : arrDomainU = Rhino.SurfaceDomain(strSrf, 0)
Dim dblUStep : dblUStep = (arrDomainU(1)-arrDomainU(0))/arrCount(0)
Dim arrDomainV : arrDomainV = Rhino.SurfaceDomain(strSrf, 1)
Dim dblVStep : dblVStep = (arrDomainV(1)-arrDomainV(0))/arrCount(1)
Dim uCount, vCount
For uCount=arrDomainU(0) To arrDomainU(1) Step dblUStep
For vCount=arrDomainV(0) To arrDomainV(1) Step dblVStep
Dim arrFrame : arrFrame = Rhino.SurfaceFrame(strSrf, array(uCount,vCount))
Dim arrSCurv : arrSCurv = Rhino.SurfaceCurvature(strSrf, array(uCount,vCount))
Dim dblGaus : dblGaus = 1+Abs(arrSCurv(6)*1000)
Call Rhino.AddCircle(arrFrame, dblGaus)
'Call Rhino.AddPlaneSurface(arrFrame, dblGaus, dblGaus)
Next
Next
End Function
Call Main()
Sub Main()
Dim strSurface : strSurface = Rhino.GetObject("select a surface on which to draw", 8)
Dim intU : intU = Rhino.GetInteger("how many in U?", 10)
Dim intV : intV = Rhino.GetInteger("how many in V?", 10)
Call DivideSurface (strSurface, array(intU,intV))
End Sub
Function DivideSurface (strSrf, arrCount)
DivideSurface = Null
If Not Rhino.IsSurface(strSrf) Then Exit Function
If Not IsNumeric(arrCount(0)) Then Exit Function
If Not IsNumeric(arrCount(1)) Then Exit Function
arrCount(0) = CInt(arrCount(0))
arrCount(1) = CInt(arrCount(1))
Dim arrDomainU : arrDomainU = Rhino.SurfaceDomain(strSrf, 0)
Dim dblUStep : dblUStep = (arrDomainU(1)-arrDomainU(0))/arrCount(0)
Dim arrDomainV : arrDomainV = Rhino.SurfaceDomain(strSrf, 1)
Dim dblVStep : dblVStep = (arrDomainV(1)-arrDomainV(0))/arrCount(1)
Dim uCount, vCount
For uCount=arrDomainU(0) To arrDomainU(1) Step dblUStep
For vCount=arrDomainV(0) To arrDomainV(1) Step dblVStep
Dim arrFrame : arrFrame = Rhino.SurfaceFrame(strSrf, array(uCount,vCount))
Dim arrSCurv : arrSCurv = Rhino.SurfaceCurvature(strSrf, array(uCount,vCount))
Dim dblGaus : dblGaus = 1+Abs(arrSCurv(6)*1000)
Call Rhino.AddCircle(arrFrame, dblGaus)
'Call Rhino.AddPlaneSurface(arrFrame, dblGaus, dblGaus)
Next
Next
End Function
sin(x) & cos(y) surface
Option Explicit
'An example of using the Rhino.AddSrfControlPtGrid method
Call waveSrf 60
'wave srf function of cos/sin
Function WaveSrf (res)
Dim u,v
Dim Pi : Pi = 3.14159265
Dim x, y, z
Dim uAlt, vAlt
Dim dblStep : dblStep = 2*pi/res
ReDim arrPoints(-1)
For u=0 To 2*pi Step dblStep
For v=0 To 2*pi Step dblStep
x = u
y = v
z = cos(v)+sin(u)
'z = sin(u*v)
'z = sin((u)*(v)+u*u*u+v*v*v)
ReDim Preserve arrPoints(Ubound(arrPoints)+1)
arrPoints(Ubound(arrPoints)) = array(x,y,z)
Next
Next
If IsArray(arrPoints) Then
Rhino.AddSrfControlPtGrid array(res+1, res+1), arrPoints
End If
End Function
'An example of using the Rhino.AddSrfControlPtGrid method
Call waveSrf 60
'wave srf function of cos/sin
Function WaveSrf (res)
Dim u,v
Dim Pi : Pi = 3.14159265
Dim x, y, z
Dim uAlt, vAlt
Dim dblStep : dblStep = 2*pi/res
ReDim arrPoints(-1)
For u=0 To 2*pi Step dblStep
For v=0 To 2*pi Step dblStep
x = u
y = v
z = cos(v)+sin(u)
'z = sin(u*v)
'z = sin((u)*(v)+u*u*u+v*v*v)
ReDim Preserve arrPoints(Ubound(arrPoints)+1)
arrPoints(Ubound(arrPoints)) = array(x,y,z)
Next
Next
If IsArray(arrPoints) Then
Rhino.AddSrfControlPtGrid array(res+1, res+1), arrPoints
End If
End Function
8-figure klein bottle
more equations from javaview.be
Option Explicit
'Another example of using the Rhino.AddSrfControlPtGrid method
Call Klein (60)
Function Klein(res)
Dim u,v
Dim Pi : Pi = 3.14159265
Dim x, y, z
Dim uAlt, vAlt
Dim dblStep : dblStep = 2*pi/res
ReDim arrPoints(-1)
For u=0 To 2*pi Step dblStep
For v=0 To 2*pi Step dblStep
Dim a : a = 2
x = (a + cos(u/2)*sin(v) - sin(u/2)*sin(2*v))*cos(u)
y = (a + cos(u/2)*sin(v) - sin(u/2)*sin(2*v))*sin(u)
z = (sin(u/2)*sin(v)) + (cos(u/2)*sin(2*v))
ReDim Preserve arrPoints(Ubound(arrPoints)+1)
arrPoints(Ubound(arrPoints)) = array(x,y,z)
Next
Next
If IsArray(arrPoints) Then
Rhino.AddSrfControlPtGrid array(res+1, res+1), arrPoints
End If
End Function
'Another example of using the Rhino.AddSrfControlPtGrid method
Call Klein (60)
Function Klein(res)
Dim u,v
Dim Pi : Pi = 3.14159265
Dim x, y, z
Dim uAlt, vAlt
Dim dblStep : dblStep = 2*pi/res
ReDim arrPoints(-1)
For u=0 To 2*pi Step dblStep
For v=0 To 2*pi Step dblStep
Dim a : a = 2
x = (a + cos(u/2)*sin(v) - sin(u/2)*sin(2*v))*cos(u)
y = (a + cos(u/2)*sin(v) - sin(u/2)*sin(2*v))*sin(u)
z = (sin(u/2)*sin(v)) + (cos(u/2)*sin(2*v))
ReDim Preserve arrPoints(Ubound(arrPoints)+1)
arrPoints(Ubound(arrPoints)) = array(x,y,z)
Next
Next
If IsArray(arrPoints) Then
Rhino.AddSrfControlPtGrid array(res+1, res+1), arrPoints
End If
End Function
add a heightfield surface from rule 30
Option Explicit
Call Main()
Sub Main()
'Define the starting condition
Dim strGen : strGen = "0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0"
ReDim arrPoints(-1)
Dim intHowMany : intHowMany = Rhino.GetInteger("How many generations?",40)
Dim i,j
For j=0 To intHowMany-1
Dim arrToken : arrToken = rhino.Strtok(strGen, ",")
Dim arrCount : arrCount = array(intHowMany,Ubound(arrToken)+1)
For i=0 To Ubound(arrToken)
Dim strCurrentChar : strCurrentChar = arrToken(i)
If strCurrentChar=0 Then
ReDim Preserve arrPoints(Ubound(arrPoints)+1)
arrPoints(Ubound(arrPoints)) = array(i,j,0)
Else
ReDim Preserve arrPoints(Ubound(arrPoints)+1)
arrPoints(Ubound(arrPoints)) = array(i,j,1)
End If
Next
strGen = NextGeneration(StrGen)
Next
Call Rhino.AddSrfPtGrid (arrCount, arrPoints)
End Sub
Function NextGeneration(strGen)
Dim strCharacter, strLeftCharacter, strRightCharacter, strNextGen, arrToken
strNextGen = ""
arrToken = rhino.Strtok(StrGen, ",")
Dim i
For i=0 To Ubound(arrToken)
strCharacter = arrToken(i)
If i = 0 Then
strLeftCharacter = arrToken(Ubound(arrToken))
Else
strLeftCharacter = arrToken(i-1)
End If
If i= Ubound(arrToken) Then
strRightCharacter = arrToken(0)
Else
strRightCharacter = arrToken(i+1)
End If
If strLeftCharacter = 1 And strCharacter = 1 And strRightCharacter = 1 Then
strNextGen = strNextGen & ",0"
ElseIf strLeftCharacter = 1 And strCharacter = 1 And strRightCharacter = 0 Then
strNextGen = strNextGen & ",0"
ElseIf strLeftCharacter = 1 And strCharacter = 0 And strRightCharacter = 1 Then
strNextGen = strNextGen & ",0"
ElseIf strLeftCharacter = 1 And strCharacter = 0 And strRightCharacter = 0 Then
strNextGen = strNextGen & ",1"
ElseIf strLeftCharacter = 0 And strCharacter = 1 And strRightCharacter = 1 Then
strNextGen = strNextGen & ",1"
ElseIf strLeftCharacter = 0 And strCharacter = 1 And strRightCharacter = 0 Then
strNextGen = strNextGen & ",1"
ElseIf strLeftCharacter = 0 And strCharacter = 0 And strRightCharacter = 1 Then
strNextGen = strNextGen & ",1"
ElseIf strLeftCharacter = 0 And strCharacter = 0 And strRightCharacter = 0 Then
strNextGen = strNextGen & ",0"
End If
Next
NextGeneration = strNextGen
End Function
Call Main()
Sub Main()
'Define the starting condition
Dim strGen : strGen = "0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0"
ReDim arrPoints(-1)
Dim intHowMany : intHowMany = Rhino.GetInteger("How many generations?",40)
Dim i,j
For j=0 To intHowMany-1
Dim arrToken : arrToken = rhino.Strtok(strGen, ",")
Dim arrCount : arrCount = array(intHowMany,Ubound(arrToken)+1)
For i=0 To Ubound(arrToken)
Dim strCurrentChar : strCurrentChar = arrToken(i)
If strCurrentChar=0 Then
ReDim Preserve arrPoints(Ubound(arrPoints)+1)
arrPoints(Ubound(arrPoints)) = array(i,j,0)
Else
ReDim Preserve arrPoints(Ubound(arrPoints)+1)
arrPoints(Ubound(arrPoints)) = array(i,j,1)
End If
Next
strGen = NextGeneration(StrGen)
Next
Call Rhino.AddSrfPtGrid (arrCount, arrPoints)
End Sub
Function NextGeneration(strGen)
Dim strCharacter, strLeftCharacter, strRightCharacter, strNextGen, arrToken
strNextGen = ""
arrToken = rhino.Strtok(StrGen, ",")
Dim i
For i=0 To Ubound(arrToken)
strCharacter = arrToken(i)
If i = 0 Then
strLeftCharacter = arrToken(Ubound(arrToken))
Else
strLeftCharacter = arrToken(i-1)
End If
If i= Ubound(arrToken) Then
strRightCharacter = arrToken(0)
Else
strRightCharacter = arrToken(i+1)
End If
If strLeftCharacter = 1 And strCharacter = 1 And strRightCharacter = 1 Then
strNextGen = strNextGen & ",0"
ElseIf strLeftCharacter = 1 And strCharacter = 1 And strRightCharacter = 0 Then
strNextGen = strNextGen & ",0"
ElseIf strLeftCharacter = 1 And strCharacter = 0 And strRightCharacter = 1 Then
strNextGen = strNextGen & ",0"
ElseIf strLeftCharacter = 1 And strCharacter = 0 And strRightCharacter = 0 Then
strNextGen = strNextGen & ",1"
ElseIf strLeftCharacter = 0 And strCharacter = 1 And strRightCharacter = 1 Then
strNextGen = strNextGen & ",1"
ElseIf strLeftCharacter = 0 And strCharacter = 1 And strRightCharacter = 0 Then
strNextGen = strNextGen & ",1"
ElseIf strLeftCharacter = 0 And strCharacter = 0 And strRightCharacter = 1 Then
strNextGen = strNextGen & ",1"
ElseIf strLeftCharacter = 0 And strCharacter = 0 And strRightCharacter = 0 Then
strNextGen = strNextGen & ",0"
End If
Next
NextGeneration = strNextGen
End Function