Errors in a script

@Charly wrote:

Hello all,

I'm working on the following script for Rhino. The script should calculate the areas of the element in each layer, and export these areas and its coordinates into an Excel file. It also should open a blanc Excel file and ask you where do you want to sabe it. It works more or less, but it has many errors.
-The first is that if there is any other Excel file opened in the computer, it doesn't work, so it's necesary to close all the Excel files before.
-The second problema is that if there is more than one element in a layer, it prints the properties of these areas separately in the Excel file, but the objective is that it prints the "total" area in each layer.

The script is the following. Could anyone give a helping hand to me? Thank you very much

Charly

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,strFile
	capas = rhino.LayerNames
	numcapas = rhino.LayerCount
	strFile = Rhino.SaveFileName("Save", "Excel Files (*.xlsx)|*.xlsx|All Files (*.*)|*.*||")
	Set xlApp = CreateObject("Excel.Application")
	xlApp.Visible = True
	Set xlBook = xlApp.WorkBooks.Add()
	xlBook.SaveAs(strFile)
	j = 0

	For Each strlayer In capas
		Rhino.CurrentLayer strLayer
		'-------------------------------------
		'FALTA INVESTIGAR-CONSEGUIR CENTROIDE DE VARIAS SURF A LA VEZ
		'arrlobjects=rhino.ObjectsByLayer(strlayer,False)
		'h=rhino.SelectObjects(arrlobjects)
		'centroidlayer=rhino.SurfaceAreaCentroid(h)
		
		'	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)
				Else 
					Rhino.DeleteObject(strObject)				
				End If
				'rhino.print(strarea)
				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 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 = arrcoord(0)(0)
				xlApp.Cells(j + 2, 4).value = arrcoord(0)(1)
				xlApp.Cells(j + 2, 5).Value = arrcoord(0)(2)

				j = j + 1

				'xlApp.Quit   ' If closing excel is required
				Set xlApp = Nothing   ' the application, then release the reference.
				'---------------------------------------------------------------
			Next
		End If
	Next
	rhino.Print("FINISH!!!")
End Sub

Posts: 2

Participants: 2

Read full topic