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
