rvb Export points to Excel

export points to excel

This ilustrates how to export any kind of geometry [in this case, points] to an excel sheet, for after use. You will be able to rework yor geometry in excl, visualize data and anything you need... also this will help you import/export your files in a much lighter format, since it will simply contain what you need. Export your files to custom formats using the same workflow!

Option Explicit

'Script written by Adolfo Nadal

'Script copyrighted by archi·o·logics www.archiologics.com

'Script version martes, 20 de marzo de 2012 13:21:11

 

Call PointsToExcel()

Sub PointsToExcel()

' Launch Excel

Dim app

Set app = CreateObject("Excel.Application")

' Make it visible

app.Visible = False

 

' Add a new workbook

Dim wb

Set wb = app.workbooks.add

 

Dim strObject,arrObjects

arrObjects = Rhino.GetObjects("Points to extract data from?",1)

If IsNull(arrObjects) Then Exit Sub

 

App.Cells(1, 1).Value = "Name"

App.Cells(1, 2).Value = "XValue"

App.Cells(1,3).Value = "YValue"

App.Cells(1,4).Value = "ZValue"

 

'Extract Properties of Points

Dim intCount

For Each strObject In arrObjects

'Points Processed

If Rhino.IsPoint(strObject) Then

App.Cells(intCount + 2, 1).Value = Rhino.ObjectName(strObject)

App.Cells(intCount + 2, 2).Value = Rhino.PointCoordinates(strObject)(0)

App.Cells(intCount + 2, 3).Value = Rhino.PointCoordinates(strObject)(1)

App.Cells(intCount + 2, 4).Value = Rhino.PointCoordinates(strObject)(2)

End If

intCount = intCount + 1

Next

 

' Give the user control of Excel

app.UserControl = True

 

Dim fileSaveName, fileSavePath

fileSaveName = Rhino.DocumentName

fileSaveName = Replace(Rhino.DocumentName, ".3dm","_points"&".xls",1,-1,1)

fileSavePath = Rhino.DocumentPath

fileSaveName = fileSavePath & fileSaveName

wb.SaveAs fileSaveName

 

'app.Visible = True

app.Quit

Set app = Nothing

 

End Sub

Search Site




archi·o·logics survey

I am interested in: