surface tessellation

i created a surface tessellation made of triangles. this script is based on the use of recursive function (a function that calls itself). triangles are divided in two part until the distance between triangle centre and his projection on the surface is less than a value adjustable by the user.



Option Explicit
'Script written by andrea bugli
' http://andbug.blogspot.com
'Script version venerdì 6 febbraio 2009 15.11.11
'
'I've seen an interesting surface tessellation on http://www.opensys-log.com/ and I tried to do something different

Call Main()
Sub Main()

Call rhino.Enableredraw(False)

Dim idsrf: idsrf = rhino.getobject ("select surface", 8, True, True)
If isnull(idsrf) Then Exit Sub

Dim udomain: udomain = rhino.surfacedomain(idsrf, 0)
Dim vdomain: vdomain = rhino.SurfaceDomain(idsrf, 1)

Dim u0: u0 = udomain(0)
Dim u1: u1 = udomain(1)
Dim v0: v0 = vdomain(0)
Dim v1: v1 = vdomain(1)

Dim A: A = rhino.EvaluateSurface(idsrf, array(u0,v0))
Dim B: B = rhino.evaluatesurface(idsrf, array(u1,v0))
Dim C: C = rhino.evaluatesurface(idsrf, array(u1,v1))
Dim D: D = rhino.EvaluateSurface(idsrf, array(u0,v1))

Call recursivetriangle(idsrf, A, B, D)
Call recursivetriangle(idsrf, B, C, D)

Call rhino.EnableRedraw(True)

End Sub

Sub recursivetriangle(ByVal idsrf, ByVal A, ByVal B, ByVal D)

Dim distAB: distAB = rhino.distance(A, B)
Dim distBD: distBD = rhino.Distance(B, D)
Dim distAD: distAD = rhino.Distance(A, D)
Dim arrdist: arrdist = array(distAB, distBD, distAD)
arrdist = rhino.sortnumbers(arrdist,True)

Dim H,K,J

If distAB = arrdist(2) Then
H = A
K = B
J = D
End If
If distBD = arrdist(2) Then
H = B
K = D
J = A
End If
If distAD = arrdist(2) Then
H = A
K = D
J = B
End If

Dim Z(2)
Z(0) = (H(0)+K(0))/2
Z(1) = (H(1)+K(1))/2
Z(2) = (H(2)+K(2))/2

Dim Zuv: Zuv = rhino.surfaceclosestpoint(idsrf, Z)
Dim Zp: Zp = rhino.evaluatesurface (idsrf, Zuv)

Dim distcurv: distcurv = rhino.distance (Zp, Z)
Dim distang: distang = rhino.Distance (H, K)

If (distcurv < 0.15) and (distang< 5) Then
Call extrudedomain (idsrf, A, B, D)
Else
Call recursivetriangle (idsrf, H, J, Zp)
Call recursivetriangle (idsrf, K, J, Zp)
End If

End Sub

Sub extrudedomain (ByVal idsrf, ByVal T, ByVal S, ByVal P)

Dim Tuv: Tuv = rhino.surfaceclosestpoint(idsrf,T)
Dim Suv: Suv = rhino.surfaceclosestpoint(idsrf,S)
Dim Puv: Puv = rhino.surfaceclosestpoint(idsrf,P)

Dim nT: nT = rhino.SurfaceNormal(idsrf, Tuv)
Dim nS: nS = rhino.SurfaceNormal(idsrf, Suv)
Dim nP: nP = rhino.SurfaceNormal(idsrf, Puv)

Dim E: E = rhino.vectoradd(T, nT)
Dim F: F = rhino.vectoradd(S, nS)
Dim G: G = rhino.vectoradd(P, nP)

Dim idbase: idbase = rhino.addcurve(array(T,S,P,T), 2)
Dim idtop: idtop = rhino.AddCurve(array(E,F,G,E), 2)
'changing last numbers give different types of curve

Dim centrebase(2)
centrebase (0) = (T(0)+S(0)+P(0))/3
centrebase (1) = (T(1)+S(1)+P(1))/3
centrebase (2) = (T(2)+S(2)+P(2))/3

Dim centretop(2)
centretop (0) = (E(0)+F(0)+G(0))/3
centretop (1) = (E(1)+F(1)+G(1))/3
centretop (2) = (E(2)+F(2)+G(2))/3

Dim idtopscal: idtopscal = rhino.scaleobject(idtop, centretop, array(0.5,0.5,0.5),True)
Dim idbasescal: idbasescal = rhino.scaleobject(idbase, centrebase, array(0.8,0.8,0.8),True)
'create other two curves that are lofted to obtain a new surface

Call rhino.AddLoftSrf(array(idbase,idbasescal,idtopscal,idtop,idbase, , , , , ,True))
Call rhino.deleteobject(idbase)
Call rhino.DeleteObject(idtop)
Call rhino.DeleteObject(idtopscal)
Call rhino.DeleteObject(idbasescal)

End Sub