Tuesday, February 13, 2007

Exporting Points

Right now my job at Arup is to do solar gain calculations on a house. In order to do this I have to model the window and the shading devices in the Arup engineering software. Unfortunately engineering software is not very visual, meaning that all the shading planes have to be entered via coordinates like x, y, z. The project I'm working on has hundreds of these shading planes, to do the job manually would take several days of tedious calculations and data entry. So I wrote a little script to export all the points from a 3d rhino model to a spreadsheet in which the whole thing can be pasted into the program with one button. This saves hours of tedious time and gives me the benefit of using Rhino to make the 3d model which is extremely fast.

Here's the script:

Option Explicit


Sub PrintSurfacePoints

Dim strSurface, arrObjects
arrObjects = Rhino.GetObjects("Select surfaces", 8)
If IsNull(arrObjects) Then Exit Sub

Dim i : i = 0
Dim surfaceArray()

If IsArray(arrObjects) Then

For Each strSurface In arrObjects

Dim arrPoints
arrPoints = Rhino.SurfacePoints(strSurface)
If Not IsArray(arrPoints) Then Exit Sub

ReDim Preserve surfaceArray(i)
surfaceArray(i) = arrPoints
i = i+1


End If

Dim objXL
Set objXL = CreateObject("Excel.Application")

objXL.Visible = True

objXL.Columns(1).ColumnWidth = 10
objXL.Columns(2).ColumnWidth = 10
objXL.Columns(3).ColumnWidth = 10
objXL.Columns(4).ColumnWidth = 10
objXL.Columns(5).ColumnWidth = 10
objXL.Columns(6).ColumnWidth = 10
objXL.Columns(7).ColumnWidth = 10

objXL.Cells(1, 2).Value = "Base X"
objXL.Cells(1, 3).Value = "Base Y"
objXL.Cells(1, 4).Value = "Base Z"
objXL.Cells(1, 5).Value = "Top X"
objXL.Cells(1, 6).Value = "Top Y"
objXL.Cells(1, 7).Value = "Top Z"

objXL.Selection.Font.Bold = True
objXL.Selection.Interior.ColorIndex = 1
objXL.Selection.Interior.Pattern = 1 'xlSolid
objXL.Selection.Font.ColorIndex = 2

objXL.Selection.HorizontalAlignment = &hFFFFEFDD ' xlLeft

Dim intIndex
intIndex = 2

Dim d
For d = 0 To i-1 Step 1

Dim strPoint, arrPt
Dim counter: counter = 0

For counter = 0 To 2 Step 2
arrPt = surfaceArray(d)(counter)
objXL.Cells(intIndex, 2).Value = Round(arrPt(0),4)
objXL.Cells(intIndex, 3).Value = Round(arrPt(1),4)
objXL.Cells(intIndex, 4).Value = Round(arrPt(2),4)
arrPt = surfaceArray(d)(counter+1)
objXL.Cells(intIndex, 5).Value = Round(arrPt(0),4)
objXL.Cells(intIndex, 6).Value = Round(arrPt(1),4)
objXL.Cells(intIndex, 7).Value = Round(arrPt(2),4)
objXL.Cells(intIndex, 8).Value = 100
objXL.Cells(intIndex, 9).Value = 0

objXL.Cells(intIndex, 1).Value = "surface " & d+1
intIndex = intIndex + 1


objXL.UserControl = True

End Sub