This is the first set of a developing series of image reading scripts designed to bridge hand sketching with three-dimensional modeling. Inspired by a project by Onur Gun, the manifestation of form from relative image intensities begins to open rapid spatial development.

Rhino Script

Option Explicit
'Script written by <David Mans>
'adapted from work by Che Wei Wang
'www.cwwang.com
'Script copyrighted by <NeoArchaic Studio>
'Script version Tuesday, March 18, 2008 7:40:18 AM

Call Main()
Sub Main()
	Dim rows, cols, tol, height,unit
	Dim arrItems, arrValues, arrResults
	arrItems = array("columns", "rows", "tolerance", "maximum_height", "unit_width")
	arrValues = array(10, 10, 0, 10, 10)
	arrResults = Rhino.PropertyListBox(arrItems, arrValues,, "Image Parameters")
	
	cols = CDbl(arrResults(0))
	rows = CDbl(arrResults(1))
	If CDbl(arrResults(2)) > 1 Then
		tol = 1
	Else
		tol = CDbl(arrResults(2))
	End If
	
	height = CDbl(arrResults(3))
	unit = CDbl(arrResults(4))
	
	Dim arrImg, arrExist, strInput
	
	arrImg = arrImageSample(cols, rows)
	' image outputs (0)red(1)green(2)blue(3)alpha(4)hue(5)saturation(6)luminance
	
	strInput = Rhino.GetString("Select Image Reading Method", "Normalized_Pannel", array("Banding", "Segments", "Cylinders", "Horizontal_Plates", "Faceted", "Normalized_Pannel", "Surface", "PointCloud"))
	If isNull(strInput) Then Exit Sub
	
	Call Rhino.EnableRedraw(False)
	If CStr(strInput) = "Banding" Then
		arrExist = banding(arrImg(6), tol, height, unit)
	End If
	If CStr(strInput) = "Segments" Then
		arrExist = segments(arrImg(6), tol, height, unit)
	End If
	If CStr(strInput) = "Cylinders" Then
		arrExist = cylinders(arrImg(6), tol, height, unit)
	End If
	If CStr(strInput) = "Horizontal_Plates" Then
		arrExist = plates(arrImg(6), tol, height, unit)
	End If
	If CStr(strInput) = "Faceted" Then
		arrExist = loftPannels(arrImg(6), tol, height, unit)
	End If
	If CStr(strInput) = "Normalized_Pannel" Then
		arrExist = uniformPannels(arrImg(6), tol, height, unit)
	End If
	If CStr(strInput) = "Surface" Then
		arrExist = surface(arrImg(6), height, unit)
	End If
	If CStr(strInput) = "PointCloud" Then
		arrExist = cloud(arrImg(0), arrImg(1), arrImg(2), arrImg(6), height, unit)
	End If
	Call Rhino.EnableRedraw(True)
	
End Sub
Function arrImageSample(cols, rows)
	arrImageSample = Null
	'Instantiate the RhPicture Object
	Dim RhPicture : Set RhPicture = Rhino.GetPlugInObject("RhPicture")
	If IsNull(RhPicture) Then Exit Function
	
	'Load an arbitrary image
	If Not RhPicture.LoadImage() Then 
		Call Rhino.Print("Image not loaded")
		Exit Function
	End If
		
	'Get the width and height
	Dim w : w = RhPicture.Width()
	Dim h : h = RhPicture.Height()

	If IsNull(w) Or IsNull(h) Then
		Call Rhino.Print("No valid image data")
		Exit Function
	End If
	
	Dim x, y, i,j
	Dim r, g, b, a, hu, s, u
	ReDim r(rows), g(rows), b(rows), a(rows), hu(rows), s(rows), u(rows)
	Dim rValSet, gValSet, bValSet, aValSet, hValSet, sValSet, uValSet
	ReDim rValSet(cols), gValSet(cols), bValSet(cols), aValSet(cols), hValSet(cols), sValSet(cols), uValSet(cols)
	
	'Sample Image returning all values between zero and one
	For i = 0 To cols Step 1
		For j = 0 To rows Step 1
			x = int(w / cols) * i
			y = int(h / rows) * j
			
			If x > w Then
				x = w
			End If
			
			If y > h Then
				y = h
			End If
			
			r(j) = RhPicture.Red(x, y) / 255
			g(j) = RhPicture.Green(x, y) / 255
			b(j) = RhPicture.Blue(x, y) / 255
			a(j) = RhPicture.Alpha(x, y) / 255
			hu(j) = RhPicture.Hue(x, y) / 360
			s(j) = RhPicture.Saturation(x, y)
			u(j) = RhPicture.Luminance(x, y)
			
		Next
		rValSet(i) = r
		gValSet(i) = g
		bValSet(i) = b
		aValSet(i) = a
		hValSet(i) = hu
		sValSet(i) = s
		uValSet(i) = u
	Next
	Set RhPicture = Nothing
	' image outputs (0)red(1)green(2)blue(3)alpha(4)hue(5)saturation(6)luminance
	arrImageSample = array(rValSet, gValSet, bValSet, aValSet, hValSet, sValSet, uValSet)
End Function
Function plates(arrInput, min, max, spacing)
	plates = Null
	Dim i,j,r,cols,rows
	cols = uBound(arrInput)
	rows = uBound(arrInput(0))
	Dim mvPlane,plate()
	r = 0
	ReDim plate(r)
	For i = 0 To cols - 1 Step 1
		For j = 0 To rows Step 1
			If arrInput(i)(j) > min Then
				mvPlane = Rhino.MovePlane(Rhino.WorldXYPlane(), array(spacing * i, spacing * j, max * arrInput(i)(j)))
				ReDim Preserve plate(r)
				plate(r) = Rhino.AddPlaneSurface(mvPlane, spacing, spacing)
				
				r = r + 1
			End If
		Next
	Next
	plates = plate
End Function
Function cylinders(arrInput, min, max, spacing)
	cylinders = Null
	Dim i,j,r,cols,rows
	cols = uBound(arrInput)
	rows = uBound(arrInput(0))
	Dim mvPlane,plate()
	r = 0
	ReDim plate(r)
	For i = 0 To cols - 1 Step 1
		For j = 0 To rows Step 1
			If arrInput(i)(j) > min Then
				mvPlane = Rhino.MovePlane(Rhino.WorldXYPlane(), array(spacing * i, spacing * j, 0))
				ReDim Preserve plate(r)
				plate(r) = Rhino.AddCylinder(mvPlane(0), array(mvPlane(0)(0), mvPlane(0)(1), mvPlane(0)(2) + max * arrInput(i)(j)), spacing * .5)
				
				r = r + 1
			End If
		Next
	Next
	cylinders = plate
End Function
Function banding(arrInput, min, max, spacing)
	banding = Null
	Dim i,j,r,cols,rows
	cols = uBound(arrInput)
	rows = uBound(arrInput(0))
	Dim mvPlane, pSet(),band()
	ReDim band(cols)
	For i = 0 To cols - 1 Step 1
		r = 0
		ReDim pSet(r)
		For j = 0 To rows Step 1
			If arrInput(i)(j) > min Then
				mvPlane = Rhino.MovePlane(Rhino.WorldXYPlane(), array(spacing * i, spacing * j, max * arrInput(i)(j)))
				
				ReDim Preserve pSet(r)
				pSet(r) = mvPlane(0)
				r = r + 1
			End If
		Next
		band(i) = Rhino.AddInterpCurve(pSet)
	Next
	banding = band
End Function
Function surface(arrInput, max, spacing)
	surface = Null
	Dim i,j,r,cols,rows
	cols = uBound(arrInput)
	rows = uBound(arrInput(0))
	Dim mvPlane, pSet()
	r = 0
	ReDim pSet(r)
	For i = 0 To cols - 1 Step 1
		For j = 0 To rows - 1 Step 1
			mvPlane = Rhino.MovePlane(Rhino.WorldXYPlane(), array(spacing * i, spacing * j, max * arrInput(i)(j)))
			ReDim Preserve pSet(r)
			pSet(r) = mvPlane(0)
			r = r + 1
		Next
	Next
	Call Rhino.AddSrfPtGrid(array(cols, rows), pSet, array(3, 3))
	surface = array()
End Function
Function segments(arrInput, min, max, spacing)
	segments = Null
	Dim i,j,k,r,s,cols,rows
	cols = uBound(arrInput)
	rows = uBound(arrInput(0))
	Dim mvPlane, pSet(),band()
	Dim trFa(),arrTrFa()
	ReDim band(cols),trFa(rows),arrTrFa(cols)
	For i = 0 To cols - 1 Step 1
		r = 0
		For j = 0 To rows Step 1
			If arrInput(i)(j) > min Then
				trFa(j) = True
				ReDim pSet(r)
				pSet(r) = array(i * spacing, j * spacing, max * arrInput(i)(j))
				r = r + 1
			Else
				trFa(j) = False
			End If
		Next
		arrTrFa(i) = trFa
	Next
	
	Dim ptGroup(),ptSet(),arrPts(),crvVal(),crvBln
	ReDim arrPts(cols),crvVal(cols)
	
	For i = 0 To cols - 1 Step 1
		r = 0
		s = 0
		If arrTrFa(i)(0) = True And arrTrFa(i)(1) = True Then
			ReDim Preserve ptGroup(r)
			ptGroup(r) = array(i * spacing, 0 * spacing, max * arrInput(i)(0))
			r = r + 1
		End If
		For j = 1 To rows - 1 Step 1
			
			If arrTrFa(i)(j) = True And arrTrFa(i)(j + 1) = True And arrTrFa(i)(j - 1) = False Then
				ReDim Preserve ptGroup(r)
				ptGroup(r) = array(i * spacing, j * spacing, max * arrInput(i)(j))
				r = r + 1
			End If
			
			If arrTrFa(i)(j) = True And arrTrFa(i)(j - 1) = True Then
				ReDim Preserve ptGroup(r)
				ptGroup(r) = array(i * spacing, j * spacing, max * arrInput(i)(j))
				r = r + 1
			End If
			If arrTrFa(i)(j) = True And arrTrFa(i)(j + 1) = False Then
				r = 0
				ReDim Preserve ptSet(s)
				ptSet(s) = ptGroup
				s = s + 1
			End If
			If s = 0 Then 
				crvBln = False
			Else
				crvBln = True
			End If
		Next
		arrPts(i) = ptSet
		crvVal(i) = crvBln
	Next
	
	Dim cntA,bandSet()
	s = 0
	For i = 0 To cols - 1 Step 1
		r = 0
		If crvVal(i) = True Then
			cntA = uBound(arrPts(i))
			For j = 0 To cntA Step 1
				ReDim band(r)
				band(r) = Rhino.AddCurve(arrPts(i)(j))
				r = r + 1
			Next
			ReDim bandSet(s)
			bandSet(s) = band
			s = s + 1
		End If
	Next
	segments = bandSet
End Function
Function uniformPannels(arrInput, min, max, spacing)
	uniformPannels = Null
	Dim i,j,k,r,s,cols,rows
	cols = uBound(arrInput)
	rows = uBound(arrInput(0))
	Dim pSet()
	Dim trFa(),arrTrFa()
	ReDim band(cols),trFa(rows),arrTrFa(cols)
	For i = 0 To cols - 1 Step 1
		r = 0
		For j = 0 To rows Step 1
			If arrInput(i)(j) > min Then
				trFa(j) = True
				ReDim pSet(r)
				pSet(r) = array(i * spacing, j * spacing, max * arrInput(i)(j))
				r = r + 1
			Else
				trFa(j) = False
			End If
		Next
		arrTrFa(i) = trFa
	Next
	
	Dim tempSrf,srfPlane()
	tempSrf = Rhino.AddSrfPt(array(array(-spacing * .5, -spacing * .5, 0),array(-spacing * .5, spacing * .5, 0),array(spacing * .5, spacing * .5, 0),array(spacing * .5, -spacing * .5, 0)))
	
	r = 0
	For i = 1 To cols - 1 Step 1
		For j = 1 To rows - 1 Step 1
			If arrTrFa(i - 1)(j) = True And arrTrFa(i)(j) = True And arrTrFa(i)(j - 1) = True Then
				ReDim Preserve srfPlane(r)
				srfPlane(r) = Rhino.OrientObject(tempSrf, array(array(0, 0, 0), array(1, 0, 0), array(0, 1, 0)), array(array(i * spacing, j * spacing, max * arrInput(i)(j)), array((i - 1) * spacing, j * spacing, max * arrInput(i - 1)(j)), array(i * spacing, (j - 1) * spacing, max * arrInput(i)(j - 1))), 1)
				r = r + 1
			End If			
		Next
	Next
	
	Call Rhino.DeleteObject(tempSrf)
	uniformPannels = srfPlane
End Function
Function loftPannels(arrInput, min, max, spacing)
	loftPannels = Null
	Dim i,j,k,r,s,cols,rows
	cols = uBound(arrInput)
	rows = uBound(arrInput(0))
	Dim pSet()
	Dim trFa(),arrTrFa()
	ReDim band(cols),trFa(rows),arrTrFa(cols)
	
	For i = 0 To cols - 1 Step 1
		r = 0
		For j = 0 To rows Step 1
			If arrInput(i)(j) > min Then
				trFa(j) = True
				ReDim pSet(r)
				pSet(r) = array(i * spacing, j * spacing, max * arrInput(i)(j))
				r = r + 1
			Else
				trFa(j) = False
			End If
		Next
		arrTrFa(i) = trFa
	Next
	
	Dim srfOutput()	
	r = 0	
	For i = 1 To cols - 1 Step 1
		For j = 1 To rows - 1 Step 1
			If arrTrFa(i - 1)(j) = True And arrTrFa(i - 1)(j - 1) = True And arrTrFa(i)(j) = True And arrTrFa(i)(j - 1) = True Then
				ReDim Preserve srfOutput(r)
				srfOutput(r) = Rhino.AddSrfPt(array(array((i - 1) * spacing, j * spacing, max * arrInput(i - 1)(j)), array((i - 1) * spacing, (j - 1) * spacing, max * arrInput(i - 1)(j - 1)), array(i * spacing, (j - 1) * spacing, max * arrInput(i)(j - 1)), array(i * spacing, j * spacing, max * arrInput(i)(j))))
				r = r + 1
			End If			
		Next
	Next
			
	loftPannels = srfOutput
End Function
Function cloud(arrInputX, arrInputY, arrInputZ, arrInputR, spacing, rad)
	cloud = Null
	Dim i,j,r,cols,rows
	cols = uBound(arrInputX)
	rows = uBound(arrInputX(0))
	Dim mvPlane, arrbln, pSet()
	arrbln = Rhino.GetBoolean("Type of Data Representation", array("Representation", "points", "spheres"), array(False))
	r = 0
	For i = 0 To cols - 1 Step 1
		For j = 0 To rows - 1 Step 1
			ReDim Preserve pSet(r)
			pSet(r) = array(arrInputX(i)(j) * spacing, arrInputY(i)(j) * spacing, arrInputZ(i)(j) * spacing)
			
			If arrbln(0) = True Then
				Call Rhino.addsphere(pSet(r), arrInputR(i)(j) * rad)
			Else
				Call Rhino.AddPoint(pSet(r))
			End If
			r = r + 1
		Next
	Next
	cloud = pSet
End Function