Option Explicit
‘Script written by Adolfo Nadal
‘Script copyrighted by Archiologics
‘Script version domingo, 16 de noviembre de 2008 12:52:20
Call Main()
Sub Main()
’SURFACE DECLARATIONS AND SO ON———————————————————————————————
Dim intU,intV, uDom, vDom, strSrf
strSrf = Rhino.GetObject(“srf”,8,True)
If IsNull(strSrf) Then Exit Sub
intU = Rhino.GetInteger(“u”,20)
intV = Rhino.GetInteger(“v”,20)
uDom = Rhino.SurfaceDomain(strSrf,0)
vDom = Rhino.SurfaceDomain(strSrf,1)
Dim uStep : uStep = (UDom(1) – UDom(0)) / intU
Dim vStep : vStep = (VDom(1) – VDom(0)) / intV
Dim t,s, u, v
ReDim arrFrame(intU,intV)
ReDim arrNormal(intU,intV)
Dim dblDist, dblDistAvg : dblDistAvg = 0
Dim arrSrfLines(), arrSrfLines2(),arrNrLines(), nrcounter, srcounter, srcounter2, distcounter, arrPts
srcounter = 0
srcounter2 = 0
nrcounter = 0
distcounter = 0
’DIM VARIABLES WHICH ARE GOING TO DEFINE HOW INTRICATE THE WEAVING IS (BASICALLY THE MODS)———————————-
Dim a, b
a = 1
b = 1
Rhino.EnableRedraw False
For t = 0 To intU
For s = 0 To intV
u = uDom(0) + uStep * t
v = vDom(0) + vStep * s
arrFrame(t,s) = Rhino.SurfaceFrame (strSrf, Array(u,v))
’DISTANCE BETWEEN CORNER POINTS EVERY ITERATION FOR RECURSION
’LET US MEASURE THE DISTANCE ON THE SURFACE: COMPARE THAT TO THE AVERAGE IN ORDER TO KNOW WHICH ONES TO DO
If t> 0 And s>0 Then
distcounter = distcounter + 1
Dim strCrvDist : strCrvDist = Rhino.AddInterpCrvOnSrf(strSrf,array(arrFrame(t,s)(0),arrFrame(t-b,s-b)(0)))
If Not isNull(strCrvDist) Then
Rhino.DeleteObject strCrvDist
End If
’MAKE A SQUARE IN THIS POSITIONS———————————————————————-
’ If t >= a And s >= a Then
’ distcounter = distcounter + 1
’ arrPts = array(arrFrame(t,s)(0),arrFrame(t,s-a)(0),arrFrame(t-a,s-a)(0),arrFrame(t-a,s)(0))
’ Rhino.CurrentLayer “Layer 01″
’ ReDim Preserve arrSrfLines(srcounter)
’ arrSrfLines(srcounter) = Subdivide (arrPts,strSrf,0,1)
’ srcounter = srcounter +1
’ End If
If t>=b And s>=b Then ‘And a<>b
distcounter = distcounter + 1
arrPts = array(arrFrame(t,s)(0),arrFrame(t,s-b)(0),arrFrame(t-b,s-b)(0),arrFrame(t-b,s)(0))
Rhino.CurrentLayer “Skin1_lines”
ReDim Preserve arrSrfLines2(srcounter2)
arrSrfLines2(srcounter2) = Subdivide (arrPts,strSrf,0,1)
srcounter2 = srcounter2 +1
End If
End If
Next
Next
’Dim opt : opt = 1
’Rhino.CurrentLayer “Text”
’Rhino.AddText “iteration” & vbCrlf & ” ” & dbldist & vbCrlf & “u: ” & intU & vbCrlf & “v: ” & intV & vbCrlf & ” ” & opt,array(arrFrame(0,0)(0)(0),arrFrame(0,0)(0)(1)-0.5,arrFrame(0,0)(0)(2)),0.5
’Rhino.HideObject strSrf
Rhino.EnableRedraw True
End Sub
Function Subdivide(arrPts,strSrf, dblDistAvg, distCounter)
Dim dblThreshold1,dblThreshold2,dblThreshold3,dblThreshold4
’CALCULATE RANDOM POINT WITHIN THE 4 GIVEN POINTS
Dim dblDist
Dim strPoly : strPoly = Rhino.AddInterpCrvOnSrf(strSrf,array(arrPts(0),arrPts(1),arrPts(2),arrPts(3),arrPts(0)))
If isNull(strPoly) Then Exit Function
dblDist = Rhino.CurveLength (strPoly)
If isNull(strPoly) Then Exit Function
dblDistAvg = dblDist + dblDistAvg
’Rhino.Print “distCounter: ” & distCounter & ” dblDistAvg/t: ” & dblDistAvg/(distcounter) & ” dblDist: ” & dblDist
Dim arrPtCenter : arrPtCenter = rndCPtWithin (arrPts,strPoly,strSrf)
Rhino.DeleteObject strPoly
’Dim strPtCenter : strPtCenter = Rhino.AddPoint (arrPtCenter)
’Rhino.ObjectColor strPtCenter,vbblue
’CALCULATE PARAMETERS OF NEW POINTS AND ORIGINAL T,S POINTS
Dim arrOriParam : arrOriParam = Rhino.SurfaceClosestPoint(strSrf, arrPts(0))
Dim arrOriParam2 : arrOriParam2 = Rhino.SurfaceClosestPoint(strSrf, arrPts(2))
Dim arrParam : arrParam = Rhino.SurfaceClosestPoint(strSrf,arrPtCenter)
’CALCULATE THE OTHER 3 POINTS TO BUILD THE SUBDIVISION
Dim arrPt1, arrPt2, arrPt3, arrPt4, arrPtnew
arrPt1 = Rhino.EvaluateSurface(strSrf,array(arrParam(0),arrOriParam2(1)))
arrPt2 = Rhino.EvaluateSurface(strSrf,array(arrOriParam2(0),arrParam(1)))
arrPt3 = Rhino.EvaluateSurface(strSrf,array(arrParam(0),arrOriParam(1)))
arrPt4 = Rhino.EvaluateSurface(strSrf,array(arrOriParam(0),arrParam(1)))
’DRAW CURVES ON SURFACE———————————————————————–
’THESE DRAW LINES IN THE SQUARE
’ Dim arrSrfLines : arrSrfLines = Rhino.AddInterpCrvOnSrf (strSrf,array(arrPts(3),arrPts(1)))
Dim arrSrfLines2 : arrSrfLines2 = Rhino.AddInterpCrvOnSrf (strSrf, array(arrPTs(0),arrPts(2)))
’THESE DRAW LINES IN THE FOUR SUBSQUARES
Dim strCrv_a1 : strCrv_a1 = Rhino.AddInterpCrvOnSrf (strSrf,array(arrPts(0),arrPtCenter))
’ Dim strCrv_a2 : strCrv_a2 = Rhino.AddInterpCrvOnSrf (strSrf,array(arrPt3,arrPt4))
’ Dim strCrv_b1 : strCrv_b1 = Rhino.AddInterpCrvOnSrf (strSrf,array(arrPt4,arrPt1))
Dim strCrv_b2 : strCrv_b2 = Rhino.AddInterpCrvOnSrf (strSrf,array(arrPts(1),arrPtCenter))
Dim strCrv_c1 : strCrv_c1 = Rhino.AddInterpCrvOnSrf (strSrf,array(arrPts(2),arrPtCenter))
’ Dim strCrv_c2 : strCrv_c2 = Rhino.AddInterpCrvOnSrf (strSrf,array(arrPt2,arrPt1))
’ Dim strCrv_d1 : strCrv_d1 = Rhino.AddInterpCrvOnSrf (strSrf,array(arrPt2,arrPt3))
Dim strCrv_d2 : strCrv_d2 = Rhino.AddInterpCrvOnSrf (strSrf,array(arrPts(3),arrPtCenter))
Rhino.AddInterpCrvOnSrf strSrf,array(arrPts(0),arrPts(1),arrPts(2),arrPts(3),arrPts(0))
’EXTEND END POINTS OF CURVE———————————————————————-
Dim opt pt = 1
’ If Not IsNull (arrSrfLines) Then
’ Call Rhino.ExtendCurveLength(arrSrfLines,opt,1,Rhino.CurveLength(arrSrfLines))
’ End If
’ If Not IsNull (arrSrfLines) Then
’ Call Rhino.ExtendCurveLength(arrSrfLines,opt,0,Rhino.CurveLength(arrSrfLines))
’ End If
If Not IsNull (arrSrfLines2) Then
Call Rhino.ExtendCurveLength(arrSrfLines2,opt,1,0.1*Rhino.CurveLength(arrSrfLines2))
End If
If Not IsNull (arrSrfLines2) Then
Call Rhino.ExtendCurveLength(arrSrfLines2,opt,0,0.1*Rhino.CurveLength(arrSrfLines2))
End If
If Not IsNull (strCrv_a1) Then
Call Rhino.ExtendCurveLength(strCrv_a1,opt,1,0.25*Rhino.CurveLength(strCrv_a1))
End If
’ If Not IsNull (strCrv_a2) Then
’ Call Rhino.ExtendCurveLength(strCrv_a2,opt,1,0.5*Rhino.CurveLength(strCrv_a2))
’ End If
’ If Not IsNull (strCrv_b1) Then
’ Call Rhino.ExtendCurveLength(strCrv_b1,opt,1,0.5*Rhino.CurveLength(strCrv_b1))
’ End If
If Not IsNull (strCrv_b2) Then
Call Rhino.ExtendCurveLength(strCrv_b2,opt,1,0.25*Rhino.CurveLength(strCrv_b2))
End If
If Not IsNull (strCrv_c1) Then
Call Rhino.ExtendCurveLength(strCrv_c1,opt,1,0.25*Rhino.CurveLength(strCrv_c1))
End If
’ If Not IsNull (strCrv_c2) Then
’ Call Rhino.ExtendCurveLength(strCrv_c2,opt,1,0.5*Rhino.CurveLength(strCrv_c2))
’ End If
’ If Not IsNull (strCrv_d1) Then
’ Call Rhino.ExtendCurveLength(strCrv_d1,opt,1,0.5*Rhino.CurveLength(strCrv_d1))
’ End If
If Not IsNull (strCrv_d2) Then
Call Rhino.ExtendCurveLength(strCrv_d2,opt,1,0.25*Rhino.CurveLength(strCrv_d2))
End If
’CALCULATE DISTANCES TO SEE FURTHER RECURSION
dblThreshold1 = Rhino.Distance(arrPts(0),arrPtCenter)
dblThreshold2 = Rhino.Distance(arrPts(1),arrPtCenter)
dblThreshold3 = Rhino.Distance(arrPts(2),arrPtCenter)
dblThreshold4 = Rhino.Distance(arrPts(3),arrPtCenter)
’ Rhino.Print “dblThreshold1 ” & dblThreshold1
’ Rhino.Print “dblThreshold2 ” & dblThreshold2
’ Rhino.Print “dblThreshold3 ” & dblThreshold3
’ Rhino.Print “dblThreshold4 ” & dblThreshold4
If dblThreshold1 > 2 Then
Subdivide array(arrPts(0),arrPt4,arrPtCenter,arrPt3),strSrf, dblDistAvg, distCounter
’Rhino.Print “Subdivide1″
End If
’ If dblThreshold2 > 3.6 Then
’ Subdivide array(arrPts(1),arrPt1,arrPtCenter,arrPt4),strSrf, dblDistAvg, distCounter
’ Rhino.Print “Subdivide2″
’ End If
If dblThreshold3 > 4 Then
Subdivide array(arrPts(2),arrPt2,arrPtCenter,arrPt1),strSrf, dblDistAvg, distCounter
’Rhino.Print “Subdivide3″
End If
’ If dblThreshold4 > 4.8 Then
’ Subdivide array(arrPts(3),arrPt3,arrPtCenter,arrPt2),strSrf, dblDistAvg, distCounter
’ Rhino.Print “Subdivide4″
’ End If
’ Subdivide = array(strCrv_a1,strCrv_a2,strCrv_b1,strCrv_b2,strCrv_c1,strCrv_c2,strCrv_d1,strCrv_d2)
End Function
Function rndCPtWithin(arrPts,strPoly,strSrf)
Dim i, x, y, z
x = arrPts(0)(0) : y = arrPts(0)(1) : z = arrPts(0)(2)
For i = 1 To Ubound(arrPts)
x = x + arrPts(i)(0)
y = y + arrPts(i)(1)
z = z + arrPts(i)(2)
Next
x = x / (UBound(arrPts)+1)
y = y / (UBound(arrPts)+1)
z = z / (UBound(arrPts)+1)
Dim aPtCenter : aPtCenter = array(x,y,z)
If Not Rhino.IsCurveClosed(strPoly) And Rhino.IsCurveClosable(strPoly) Then
strPoly = Rhino.CloseCurve (strPoly)
End If
Dim aPtsdiv : aPtsDiv = rhino.DivideCurve(strPoly, 30)
Dim aPtDir : aPtDir = aPtsdiv(int(UBound(aPtsDiv)* rnd))
Dim vDir : vDir = rhino.VectorCreate(aptDir, aPtcenter)
vDir = rhino.VectorScale(vDir, rnd)
rndCPtWithin = rhino.PointAdd(aPtcenter, vDir)
Dim arrParam : arrParam = Rhino.SurfaceClosestPoint(strSrf,rndCPtWithin)
rndCPtWithin = Rhino.EvaluateSurface(strSrf,arrParam)
’Call rhino.DeleteObject(strPoly)
End Function
Function arbitraryValue(min, max)
Randomize
arbitraryValue = min + (max – min) * Rnd
End Function
0 responses so far ↓
There are no comments yet...Kick things off by filling out the form below.