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

PrintSurfacePoints

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

Next

End If

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


objXL.Visible = True
objXL.WorkBooks.Add


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.Range("A1:G1").Select
objXL.Selection.Font.Bold = True
objXL.Selection.Interior.ColorIndex = 1
objXL.Selection.Interior.Pattern = 1 'xlSolid
objXL.Selection.Font.ColorIndex = 2


objXL.Columns("B:B").Select
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
Next

Next

objXL.UserControl = True

End Sub