A pool of resources
Triangulate 3 Pack

  


 

This Rhino Script triangulates a surface with three pattern options

Pattern Types:

[A][A] | [A][B] | [A][B]

[A][A] | [A][B] | [B][A]

typ.0 _typ.1 _typ.2

This version of the script lays out the resulting triangular faces in a tiled grid with numbered tabs which allow for rapid reconstruction. To assemble simply match up tab numbers.

 


platform: Rhino Script
function: Fabrication

 


 

 

Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic Studio>
'Script version Monday, March 23, 2009 11:03:52 AM

Call Main()
Sub Main()
	Dim surface
	surface = Rhino.GetObject("Select Surface",8,True)
	If isnull(surface) Then Exit Sub

	Dim arrValue, cols, rows, spacing, height, typ
	typ = Rhino.GetInteger("Select Triangulation Type",0,0,2)
	If isNull(typ) Then Exit Sub

	arrValue = Rhino.PropertyListBox(array("Columns","Rows","Tile Spacing","tabHeight"),array(10,10,1,0.5))
	If isNull(arrValue) Then Exit Sub

	cols = CDbl(arrValue(0))
	rows = CDbl(arrValue(1))
	spacing = CDbl(arrValue(2))
	height = CDbl(arrValue(3))

	Dim i,j,k,r,s,t
	Dim arrVals
	Dim grid,sort,edge,surf,tri(3),outline(3)

	Call Rhino.EnableRedraw(False)
	grid = arrEvalSrf(surface, cols, rows)

	arrVals = array(array(0,0,1,1,1,0),array(1,1,0,0,0,1),array(1,0,0,1,0,0),array(0,1,1,0,1,1))

	For i = 0 To 3 Step 1
		tri(i) = triangulate(surface, grid, arrVals(i))
		If i < 2 Then
			outline(i) = flatten(tri(i),True)
		Else
			outline(i) = flatten(tri(i),False)
		End If
	Next
	sort = sortTriangles(outline,typ)
	surf = sortTriangles(tri,typ)

	edge = drawTriangle(sort)

	Call tileObjects(edge,spacing+height)

	Dim blnDir

	For i = 0 To uBound(edge) Step 1
		r=0
		s=0
		For j = 0 To uBound(edge(i)) Step 1
			If j Mod(2) Then: s=s+1: t=i : Else: r=r+1: t=i+1: End If

			If typ = 0 Then
				blnDir = False
			Else
				If r Mod(2) Then
					If typ = 2 And i Mod(2) Then: blnDir = True: Else: blnDir = False: End If
				Else
					If typ = 2 And i Mod(2) Then: blnDir = False: Else: blnDir = True: End If
				End If
			End If

			Call tabMaker(edge(i)(j)(0),height,i & "." & r & "." & 0,blnDir)
			Call tabMaker(edge(i)(j)(1),height,i & "." & t & "." & 1,blnDir)
			Call tabMaker(edge(i)(j)(2),height,i & "." & s & "." & 2,blnDir)
			Call Rhino.addsrfpt(surf(i)(j))
		Next
	Next
	Call Rhino.EnableRedraw(True)
End Sub
Function arrEvalSrf(surface, cols, rows)
	arrEvalSrf = Null
	Dim i,j
	Dim pt(), arrOutput(), dom(1), stp(1)
	ReDim pt(rows), arrOutput(cols)

	dom(0) = Rhino.SurfaceDomain(surface,0)
	dom(1) = Rhino.SurfaceDomain(surface,1)

	stp(0) = (dom(0)(1)-dom(0)(0))/cols
	stp(1) = (dom(1)(1)-dom(1)(0))/rows

	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			pt(j) = Rhino.EvaluateSurface(surface,array(dom(0)(0)+stp(0)*i,dom(1)(0)+stp(1)*j))
		Next
		arrOutput(i) = pt
	Next

	arrEvalSrf = arrOutput
End Function
Function triangulate(surface, arrPoints, arrValues)
	triangulate = Null
	Dim i,j,k,r, cols, rows
	Dim pts(), arrOutput(), pt(3), maxVal(1)

	maxVal(0) = Rhino.Max(array(arrValues(0),arrValues(2),arrValues(4)))
	maxVal(1) = Rhino.Max(array(arrValues(1),arrValues(3),arrValues(5)))

	cols = ubound(arrPoints)-maxVal(0)

	ReDim arrOutput(cols)

	For i = 0 To cols Step 1
		rows = ubound(arrPoints(i))-maxVal(1)
		ReDim pts(rows)
		For j = 0 To rows Step 1
			r=0
			For k = 0 To 2 Step 1
				pt(k) = arrPoints(i+arrValues(r))(j+arrValues(r+1))
				r=r+2
			Next
			pt(3) = pt(0)
			pts(j) = pt
			'Call Rhino.AddPolyline(pts(j))
		Next
		arrOutput(i) = pts
	Next

	triangulate = arrOutput
End Function
Function flatten(arrPoints,blnUp)
	flatten = Null
	Dim i,j,k, cols, rows
	Dim pts(), arrOutput(), tPts(3), pt(3), temp
	cols = uBound(arrPoints)
	ReDim arrOutput(cols)

	For i = 0 To cols Step 1
		rows = ubound(arrPoints(i))
		ReDim pts(rows)
		For j = 0 To rows Step 1
			For k = 0 To 3 Step 1
				tPts(k) = Rhino.AddPoint(arrPoints(i)(j)(k))
			Next
			temp = Rhino.OrientObjects(tPts,array(arrPoints(i)(j)(0),arrPoints(i)(j)(1),arrPoints(i)(j)(2)), array(array(0,0,0),array(1,0,0),array(0,1,0)))
			If blnUp = True Then
				Call Rhino.RotateObjects(temp,array(0,0,0),180,Rhino.WorldXYPlane()(2),False)
			End If

			For k = 0 To 3 Step 1
				Pt(k) = Rhino.PointCoordinates(temp(k))
				Call Rhino.DeleteObject(temp(k))
			Next
			pts(j) = pt
		Next
		arrOutput(i) = pts
	Next

	flatten = arrOutput
End Function
Function drawTriangle(arrPoints)
	drawTriangle = Null
	Dim i,j,k, cols, rows
	Dim arrTemp(), arrOutput(),lines(2)
	cols = uBound(arrPoints)
	ReDim arrOutput(cols)

	For i = 0 To cols Step 1
		rows = ubound(arrPoints(i))
		ReDim arrTemp(rows)
		For j = 0 To rows Step 1
			For k = 0 To 2 Step 1
				lines(k) = Rhino.AddLine(arrPoints(i)(j)(k),arrPoints(i)(j)(k+1))
			Next
			Call Rhino.ObjectColor(lines,RGB(255,0,0))
			arrTemp(j) = lines
		Next
		arrOutput(i) = arrTemp
	Next

	drawTriangle = arrOutput
End Function
Function sortTriangles(arrSet,blnType)
	sortTriangles = Null
	Dim i,j,k,r,a,b, cols, rows
	Dim arrTemp(), arrOutput()
	cols = uBound(arrSet(0))
	ReDim arrOutput(cols)

	For i = 0 To cols Step 1
		rows = ubound(arrSet(0)(i))
		r=1
		For j = 0 To rows Step 1
			If blnType = 0 Then
				a = array(1,1)
			ElseIf blnType = 1 Then
				a = array(1,2)
			ElseIf blnType = 2 Then
				a = array(2,2)
			End If

			If i Mod(a(0)) Then
				If j Mod(a(1)) Then
					b = array(0,1)
				Else
					b = array(2,3)
				End If
			Else
				If j Mod(a(1)) Then
					b = array(2,3)
				Else
					b = array(0,1)
				End If
			End If
			ReDim Preserve arrTemp(r)
			arrTemp(r-1) = arrSet(b(0))(i)(j)
			arrTemp(r) = arrSet(b(1))(i)(j)
			r=r+2
		Next
		arrOutput(i) = arrTemp
	Next

	sortTriangles = arrOutput
End Function
Function tileObjects(arrObjects,spacing)
	tileObjects = Null
	Dim i,j,cols,rows,arrOutput(),arrTemp()
	Dim origin, tDis, dist, bBox()
	origin = array(0,0,0)

	cols = uBound(arrObjects)
	ReDim arrOutput(cols)

	For i = 0 To cols Step 1
		rows = uBound(arrObjects(i))
		ReDim bBox(rows),arrTemp(rows)
		tDis = 0
		For j = 0 To rows Step 1
			bBox(j) = Rhino.BoundingBox(arrObjects(i)(j))
			dist = Rhino.Distance(bBox(j)(0),bBox(j)(1))
			If j = 0 Then
				Call Rhino.MoveObjects(arrObjects(i)(j),bBox(j)(0),origin)
			Else
				Call Rhino.MoveObjects(arrObjects(i)(j),bBox(j)(0),bBox(j-1)(3))
				Call Rhino.MoveObjects(arrObjects(i)(j),array(0,0,0),array(0,spacing,0))
			End If
			bBox(j) = Rhino.BoundingBox(arrObjects(i)(j))

			If tDis < dist Then
				tDis = dist
				origin = array(bBox(j)(1)(0)+spacing,0,0)
			End If
			arrTemp(j) = arrObjects(i)(j)
		Next
		arrOutput(i) = arrTemp
	Next
	tileObjects = arrOutput
End Function
Function tabMaker(curve,depth,text,blnDirection)
	tabMaker = Null
	Dim arrOutput, tPlane, pt(3), txt
	tPlane = Rhino.ViewCPlane()
	Call Rhino.ViewCPlane(,Rhino.WorldXYPlane())
	pt(0) = Rhino.CurveMidPoint(curve)
	If blnDirection = True Then
		pt(1) = Rhino.CurveStartPoint(curve)
		pt(2) = Rhino.CurveEndPoint(curve)
	Else
		pt(2) = Rhino.CurveStartPoint(curve)
		pt(1) = Rhino.CurveEndPoint(curve)
	End If
	pt(3) = Rhino.PointAdd(pt(0),Rhino.VectorRotate(Rhino.VectorScale(Rhino.VectorUnitize(Rhino.VectorCreate(pt(1),pt(2))),depth),90,Rhino.WorldXYPlane()(3)))
	arrOutput = Rhino.AddPolyline(array(pt(1),pt(3),pt(2)))
	txt = Rhino.AddText(text,pt(0),depth*0.3)
	Call Rhino.ObjectColor(txt,RGB(0,255,0))
	Call Rhino.OrientObject(txt,array(pt(0),array(pt(0)(0)+1,pt(0)(1),pt(0)(2)),array(pt(0)(0),pt(0)(1)+1,pt(0)(2))),array(pt(0),pt(1),pt(3)))
	Call Rhino.ViewCPlane(,tPlane)
	tabMaker = arrOutput
End Function


Reply