EcoPanels-Dima Chiriacov

From scripting
Jump to: navigation, search

You can find the original code here:

http://www.lolerblades.com/dimac/EcoPanels.rvb

http://www.lolerblades.com/dimac/EcoPanels.xls

http://www.lolerblades.com/dimac/EcoPanels.3dm




Option Explicit
'Script written by <Dima Chiriacov>
'Script copyrighted by <dimak1999.blogspot.com>
'Email me on <dimak1999@yahoo.com> incase there's any problems with the code
'The script only runs on quad meshes
'The code assumes the TOP as the side of the normal direction

Call PanelizeIt()
Sub PanelizeIt()
	
	
	'''''''''''Get EXCEL to run''''''''''''''''''
	Const xlDown = -4121  'xlDown constant	
	Dim bResult
	Dim arrtext:arrtext=Array("OutwardOffset", "InwardOffset","LongRadius","SmallRadius","EllipseTranslation", "Accept")
	
	
	Dim sFileName, aPoints(), meshFaceID, nMag
	Dim oExcel, oSheet, nRow, nRowCount

	' Get the name of the file to import
	sFileName = Rhino.OpenFileName("Select File","Excel Files (*.xls)|*.xls||")
	If IsNull(sFileName) Then Exit Sub

	' Launch Excel and open the specified file
	Set oExcel = CreateObject("Excel.Application")
	oExcel.Workbooks.Open(sFileName)

	' Get the active worksheet
	Set oSheet = oExcel.ActiveSheet

	' Count the number of rows that need to be processed
	nRowCount = oSheet.Range("a1", oSheet.Range("a1").End(xlDown)).Rows.Count
	
	'''''''''''Get EXCEL to run''''''''''''''''''
	
	
	
	'''''''''''''''Average triangle data into quads(Take care of negative vals)''''''''''''''''''
	
	Dim ArrNewDataList()
	n=-1
	Dim a
	For i=1 To nRowCount Step 2
		n=n+1
		a=((oSheet.Cells(i, 2).Value)+(oSheet.Cells(i+1, 2).Value))/2
		If a<0 Then
			a=0
		End If
		ReDim Preserve ArrNewDataList(n) 
		ArrNewDataList(n)=a	
		
	Next
	
	'''''''''''''''find EXCEL data top domain value and set the reverse realationship''''''''''
	Dim minVal:minVal=0
	Dim maxVal:maxVal=0
	For i=0 To Ubound(ArrNewDataList) 
		If maxVal<=ArrNewDataList(i) Then
			maxVal=ArrNewDataList(i)
		End If 
	Next		
	MsgBox "max value = " &maxVal
	
	'''''''''''Define Main Mesh Variables''''''''''''''''''
	Dim mesh:mesh=Rhino.GetObject("sel mesh",32)
	
	Dim CenterFaceMesh, VertMesh, NormalFaceMesh,FaceMesh, val, circle, f, outer, panel
	VertMesh=Rhino.MeshVertices(mesh)
	FaceMesh=Rhino.MeshFaces(mesh)
	CenterFaceMesh=Rhino.MeshFaceCenters(mesh)
	NormalFaceMesh=Rhino.MeshFaceNormals(mesh)
	ReDim plane(ubound(CenterFaceMesh))
	ReDim circle(ubound(CenterFaceMesh))
	
	Dim offsetTop:offsetTop=Rhino.GetReal("input ofset on Top side",0.3,0.1)
	Dim offsetBot:offsetBot=Rhino.GetReal("input ofset on Bottom side",0,0)
	Dim longRRel:longRrel=Rhino.GetReal("input relationship of long Radius to corner/center component distance",0.6,0,1)
	Dim smallRRel:smallRrel=Rhino.GetReal("input relationship of small Radius of ellipse to Long Radius",0.7,0.1,1)
	Dim topElllipseTranslation:topElllipseTranslation=Rhino.GetReal("input top translation of ellipse to the top thickness",0.15,0)
	Dim arcH:arcH=offsetTop+offsetBot
	
	
	Dim arrPreview() : ReDim arrPreview(UBound(NormalFaceMesh))
	Call Rhino.HideObject(mesh)
	
	

		
		
		
		Dim bln
		For i = 0 To UBound(arrPreview)
			If Not isempty(arrPreview(i))	Then
					
			
				Call Rhino.DeleteObject(arrPreview(i))
				
			End If
		Next
		
		
		MsgBox "your pannel thickness is: "&offsetTop+offsetBot
 
		Dim i,n,point	
	
	
	
		'Call changemesh(mesh)
	
	
	
		Rhino.EnableRedraw(False)
	'''''''''''Create Top Mesh ''''''''''''''''''

	Dim TopMesh:TopMesh=CreateTopMesh(mesh, offsetTop)
	Dim TopMeshVert:TopMeshVert=Rhino.MeshVertices(TopMesh)
	Dim TopMeshFace:TopMeshFace=Rhino.MeshFaces(TopMesh)
	Dim TopMeshNormF:TopMeshNormF=Rhino.MeshFaceNormals(TopMesh)
	Dim TopMeshCenterF:TopMeshCenterF=Rhino.MeshFaceCenters(TopMesh)
	Dim TopMeshfaceVert:TopMeshfaceVert=Rhino.MeshFaceVertices(TopMesh)	
	'''''''''''Create BottoM Mesh ''''''''''''''''''	
	Dim BottomMesh:BottomMesh=CreateBotMesh(mesh, offsetBot)
	Dim BottomMeshVert:BottomMeshVert=Rhino.MeshVertices(BottomMesh)
	Dim BottomMeshFace:BottomMeshFace=Rhino.MeshFaces(BottomMesh)
	Dim BottomMeshNormF:BottomMeshNormF=Rhino.MeshFaceNormals(BottomMesh)
	Dim BottomMeshCenterF:BottomMeshCenterF=Rhino.MeshFaceCenters(BottomMesh)
	Dim BottomMeshfaceVert:BottomMeshfaceVert=Rhino.MeshFaceVertices(BottomMesh)
	'MsgBox Ubound(BottomMeshfaceVert)
	''''''''''''''''''''Define Ubounds''''''''''''''''''''''''''''''''''
	Dim ctF:ctF=Ubound(NormalFaceMesh)
	Dim ctPt:ctPt=Ubound(VertMesh)
	

	
	
	
		'''''''''''''''Create Planes on Mesh quads''''''''''''''''''''''''''
	
		ReDim TopPlanesOnQuads(ctF)
		ReDim BottomPlanesOnQuads(ctF)
	
		Dim yAxisT,yAxisB,TsupportPt,BsupportPt, xaxisT, xaxisB
		'Msgbox ctf&" + "&ctpt
	
		For i=0 To ctF
		
			TSupportPt=TopMeshVert(TopMeshfaceVert(i)(0))		
			xaxisT=Rhino.VectorCreate(TSupportPt,TopMeshCenterF(i))		
		yaxisT=Rhino.VectorCrossProduct(TopMeshNormF(i),xaxisT)		
		TopPlanesOnQuads(i)=Rhino.PlaneFromFrame(TopMeshCenterF(i),xaxisT,yaxisT)
		
		
		BSupportPt=BottomMeshVert(BottomMeshfaceVert(i)(0))
		xaxisB=Rhino.VectorCreate(BSupportPt,BottomMeshCenterF(i))
		yaxisB=Rhino.VectorCrossProduct(BottomMeshNormF(i),xaxisB)
		BottomPlanesOnQuads(i)=Rhino.PlaneFromFrame(BottomMeshCenterF(i),xaxisB,yaxisB)
	Next
	
	
	'''''''''''''''Rectangles''''''''''''''''''''''''''''''
	ReDim TopOuter(ctF),BottomOuter(ctF)
	For i=0 To ctF
		'For n=0 To 4
		TopOuter(i)=Rhino.AddPolyline(Array(TopMeshVert(TopMeshfaceVert(i)(0)),TopMeshVert(TopMeshfaceVert(i)(1)),TopMeshVert(TopMeshfaceVert(i)(2)),TopMeshVert(TopMeshfaceVert(i)(3)),TopMeshVert(TopMeshfaceVert(i)(0))))
		BottomOuter(i)=Rhino.AddPolyline(Array(BottomMeshVert(BottomMeshfaceVert(i)(0)),BottomMeshVert(BottomMeshfaceVert(i)(1)),BottomMeshVert(BottomMeshfaceVert(i)(2)),BottomMeshVert(BottomMeshfaceVert(i)(3)),BottomMeshVert(BottomMeshfaceVert(i)(0))))
	Next
		
		
	'''''''''''''''Draw EllipsTop''''''''''''''''''''''''''
	
	ReDim TopEll(ctF), zT(ctF),moveZTopVal(ctF)value to translate ellips of the plane
	ReDim distA(ctF) ''distance from center to corner
	ReDim RadBigTop(ctF)   'radius large
	ReDim RadSmallTop(ctF) 'radius small
	Dim parA:parA=longRRel relation of big radius to corner/center distance of component''
	Dim parB:parB=smallRRel relation of smal radius to big radius of ellips''
	Dim moveZTopVec  ''transl vector'
	Dim distB'distance from point 2 to 4
	For i=0 To ctF
		distA(i)=Rhino.Distance (TopMeshCenterF(i),TopMeshVert(TopMeshfaceVert(i)(0)))
		radBigTop(i)=distA(i)*parA
		Rhino.Print "distance "&distA(i)
		'distB=Rhino.Distance(
		'If 'constrain the inner radius
		radSmallTop(i)=radBigTop(i)*parB
		
		'''translation val'''''   1/4 of the top offset
		moveZTopVal(i)=topElllipseTranslation*offsetTop
		moveZTopVec=Rhino.VectorScale(Rhino.VectorUnitize(TopMeshNormF(i)),moveZTopVal(i))
		
		'''create ellipse''''
		TopEll(i)=Rhino.AddEllipse(TopPlanesOnQuads(i),radBigTop(i),radSmallTop(i))
		'''translate/override''''''
		TopEll(i)=Rhino.MoveObject(TopEll(i),moveZTopVec)
		
		
		Next
		
		
		'''''''''''''''set apperture ratio'''''''''''''''''''''
		ReDim apperture(ctF)
		For i=0 To Ubound(ArrNewDataList)
			apperture(i)=1-ArrNewDataList(i)/maxVal
			If apperture(i)<0.2 Then
				apperture(i)=0.2
			End If
		Next		
		
		
		
		
	
	
	
		
	
		'''''''''''''''Draw EllipsBottomp''''''''''''''''''''''''''
	
		ReDim BottomEll(ctF), zB(ctF),moveZBottomVal(ctF)value to translate ellips of the plane
		ReDim distC(ctF) ''distance from center to corner
		ReDim RadBigBottom(ctF)   'radius large
		ReDim RadSmallBottom(ctF) 'radius small
		'Dim parA:parA=0.6 relation of big radius to corner/center distance of component''
		'Dim parB:parB=0.7 relation of smal radius to big radius of ellips''
		Dim moveZBottomVec  ''transl vector'
		Dim distD'distance from point 2 to 4
		For i=0 To ctF
			distC(i)=Rhino.Distance (BottomMeshCenterF(i),BottomMeshVert(BottomMeshfaceVert(i)(0)))
			radBigBottom(i)=distC(i)*parA
			Rhino.Print "distance "&distC(i)
			'distB=Rhino.Distance(
			'If 'constrain the inner radius
			radSmallBottom(i)=radBigBottom(i)*parB
		
			'''translation val'''''   0.75 of the top move value
			moveZBottomVal(i)=0.75*moveZTopVal(i)
		moveZBottomVec=Rhino.VectorScale(Rhino.VectorUnitize(BottomMeshNormF(i)),moveZBottomVal(i))
		
		'''IMPORTANT PARTscale ellipse parameters based on EXCEl data range''''
		'''create ellipse''''here is your apperture
		BottomEll(i)=Rhino.AddEllipse(BottomPlanesOnQuads(i),radBigBottom(i)*apperture(i),radSmallBottom(i)*apperture(i))	   	 
	 	
		'''translate/override''''''
		BottomEll(i)=Rhino.MoveObject(BottomEll(i),moveZBottomVec)
		
		
		Next	
		
		
		
	
	
	
	
	
	''''''''''''''Create Panels''''''''''''''''''''''''''''''
		
	'ReDim panels(ctF)
	Dim pOne,pTwo
	For i=0 To ctF
		pTwo=Rhino.AddLoftSrf(array(TopOuter(i),TopEll(i),BottomEll(i),BottomOuter(i)),,,0)
		pOne=Rhino.AddLoftSrf(array(TopOuter(i),BottomOuter(i)),,,3)
		arrPreview(i)=Rhino.JoinSurfaces(Array(pOne(0),pTwo(0)),True)
		
		If Not IsNull(arrPreview(i)) Then
			Rhino.ObjectName arrPreview(i), "Panel " & CStr(i)
		End If
	
	Next
		
		
	Call Rhino.EnableRedraw(True)
	
	
	
	
	'''''''''''''''''''''''Delete and Hide stuff''''''''''''''''''
	Call Rhino.HideObject(mesh)
		Call Rhino.DeleteObjects (array(TopMesh,BottomMesh))	
	Call Rhino.DeleteObjects (TopOuter)
	Call Rhino.DeleteObjects(BottomOuter)
	Call Rhino.DeleteObjects(TopEll)
	Call Rhino.DeleteObjects(BottomEll)
	
	
	
	
	
	
	
	
	
	oExcel.Quit
	Set oSheet = Nothing
	Set oExcel = Nothing
	
End Sub

Function CreateTopMesh(ByVal mesh, ByVal offsetTop)
	Dim Vert, Face, Norm,p,i
	Dim newVert,NewFace,NewNorm
	Vert=Rhino.MeshVertices(mesh)
	Face=Rhino.MeshFaceVertices(mesh)
	norm=Rhino.MeshVertexNormals(mesh)
	
	ReDim newVert(Ubound(VERT)),newNorm(Ubound(norm))
	For p=0 To Ubound(Vert)
		norm(p)=Rhino.VectorUnitize(norm(p))
		Newnorm(p)=Rhino.VectorScale(norm(p),offsetTop)
		Newvert(p)=Rhino.PointAdd(vert(p),Newnorm(p))
		If vert(p)(2)=0 Then
			
			Newnorm(p)(2)=0
			Newnorm(p)=Rhino.VectorScale(Rhino.VectorUnitize(newnorm(p)),offsetTop)
 			NewVert(p)=Rhino.PointAdd(vert(p),NewNorm(p))
			
			'Newvert(p)=Rhino.VectorUnitize(NewVert(p))
			'NewVert(p)=Rhino.VectorScale'''''''''''''''''''''''''HEREEEEEEEEEEEEEEEEEEEEEEEE
		End If
		
		
	Next
	
	CreateTopMesh=Rhino.AddMesh(newvert,face)	
End Function

Function CreateBotMesh(ByVal mesh, ByVal offsetBot)
	Dim Vert, Face, Norm,p,i
	Dim newVert,NewFace,NewNorm
	Vert=Rhino.MeshVertices(mesh)
	Face=Rhino.MeshFaceVertices(mesh)
	norm=Rhino.MeshVertexNormals(mesh)
	
	ReDim newVert(Ubound(VERT)),newNorm(Ubound(norm))
	For p=0 To Ubound(Vert)
		norm(p)=Rhino.VectorReverse(norm(p))
		norm(p)=Rhino.VectorUnitize(norm(p))
		Newnorm(p)=Rhino.VectorScale(norm(p),offsetBot)
		Newvert(p)=Rhino.PointAdd(vert(p),Newnorm(p))
		If vert(p)(2)=0 Then
			Newvert(p)(2)=0
		End If
		
	Next
	
	CreateBotMesh=Rhino.AddMesh(newvert,face)
End Function

Function changemesh(ByRef mesh)
	Dim Vert, Face, Norm,p,i
	Dim newVert,NewFace,NewNorm
	Vert=Rhino.MeshVertices(mesh)
	Face=Rhino.MeshFaceVertices(mesh)
	norm=Rhino.MeshVertexNormals(mesh)
	For p=0 To Ubound(norm)
		Rhino.print vert(i)(2)
		If vert(i)(2)<5 Then
			norm(i)(2)=0
		End If
	Next
	
End Function

Function ParameterColour(dblParam)
	Dim RedComponent : RedComponent = 255 * dblParam
	If (RedComponent < 0) Then RedComponent = 0
	If (RedComponent > 255) Then RedComponent = 255
	ParameterColour = RGB(RedComponent, 0, 255 - RedComponent)
End Function