Help with a script for Rhino

Hello all,

I write because I need help with a script that I’m making for Rhino. The script calculates de area of the elements of each layer and print them into an excel file. It is necesary to have openned an Excel file previously. It works without problems, but I want to improve it making the following actions:

-The script must open an Excel file automatically, and must ask where we want to save it (the excel file).
-The script prints the x,y,z coordinates ot the centroid of each surface in an only column, but it should printe each coordinate in a differente column (a column for the “x” coordinate, another for the “y” and another for the “z”).

The script is the following. Please, could you help me with the two improvements that I need to make? Thank you a lot

Option Explicit
'Script written by <insert name>
'Script copyrighted by <insert company name>
'Script version sábado, 26 de mayo de 2012 12:16:58

Call Main()
Sub Main()
	Dim capas,numcapas,strlayer,arrobj,strobject,arrarea,strarea,arrcoord,strcoord,j,xlapp,xlsheet,xlbook,arrlobjects,centroidlayer,layercoord
	capas = rhino.LayerNames
	numcapas = rhino.LayerCount
	j = 0

	For Each strlayer In capas
		Rhino.CurrentLayer strLayer
		'	If Not isnull (centroidlayer) Then
		'		layercoord=rhino.Pt2Str(centroidlayer(0))
		'	End If
		'RHINO.Print strLayer
		If Not Rhino.IsLayerEmpty(strLayer) Then
			arrobj = rhino.objectsbylayer(strlayer, False)
			For Each strobject In arrobj
				arrarea = rhino.SurfaceArea(strobject)
				If Not IsNull(arrarea) Then
					strarea = rhino.Pt2Str(arrarea)
				End If
				arrcoord = rhino.SurfaceAreaCentroid(strobject)
				If Not isnull(arrcoord) Then
					strcoord = rhino.Pt2Str(arrcoord(0))
				End If
				'	rhino.print(strcoord)
				' Open Excel object
				On Error Resume Next
				Set xlApp = GetObject(, "excel.application")
				If err Then
					Rhino.print "Excel not found.  Operation aborted!"
					Exit Sub 
				End If
				On Error GoTo 0
				xlApp.Visible = True
				Set xlBook = xlApp.ActiveWorkbook
				Set xlSheet = xlBook.ActiveSheet

				'Place titles on sheet
				xlApp.Cells(1, 1).Value = "CAPA"
				xlApp.Cells(1, 2).Value = "Surface Area"
				xlApp.Cells(1, 3).Value = "X centroide"
				xlApp.Cells(1, 4).value = "Y centroide"
				xlApp.Cells(1, 5).value = "Z centroide"
				xlApp.Cells(1, 6).Value = "Centroide Global por Capa"

				'Extract Properties of Surfaces
				xlApp.Cells(j + 2, 1).Value = strlayer
				xlApp.Cells(j + 2, 2).Value = arrarea
				xlApp.Cells(j + 2, 3).value = strcoord
				xlApp.Cells(j + 2, 4).value = strcoord
				xlApp.Cells(j + 2, 5).Value = strcoord

				j = j + 1

				'xlApp.Quit   ' If closing excel is required
				Set xlApp = Nothing   ' the application, then release the reference.
		End If
End Sub

Hi @Charly,

Please try below things:

  1. A sample of how to create a new Excel file and save it:

    Dim xlApp,xlBook,strFile
    ’get the desination file (optionally you can just generate a path)
    strFile = Rhino.SaveFileName(“Save”, “Excel Files (.xlsx)|.xlsx|All Files (.)|.||”)

     'get excel app
     Set xlApp = CreateObject("Excel.Application")
     'make it visible (if needed)
     xlApp.Visible = True
     'add new book
     Set xlBook = xlApp.WorkBooks.Add()
     'save the book

And here is how you should change your centroid writing part of the code:

'change your centroid output like this
'(StrTok breaks down your string into array based On specified delimiter(",")
xlApp.Cells(j + 2, 3).value = Rhino.StrTok(strcoord, ",")(0)
xlApp.Cells(j + 2, 4).value = Rhino.StrTok(strcoord, ",")(1)
xlApp.Cells(j + 2, 5).Value = Rhino.StrTok(strcoord, ",")(2)

hope that helps-


Thank you very much Jarek, it works perfectly!