Forgot password?

Create an account!

Forum

« back

RhinoScript – Excel export point coordinates alongside Layer ID

Messages

Please log in to write a message.

  • 2. Hanno (Jul 23, 2015 12.33):

    Hi,

    Rhino.ObjectLayer returns the layer an object is on. So you have to loop through your points again and just use ObjectLayer instead of PointCoordinates.

    Hanno

  • 1. GRAD (Jul 22, 2015 09.59):

    Hey all,

    I discovered rhinoscript these last couple of days and found it to possibly be a very usefull tool in reporting my work. As is I've found some of the code via the internet, as I've shyed away from VBA coding for a long time.

    What I am basically trying to do is exporting the coordinates of selected points (key nodes I use in a model) to an excel file; this part I could readily pluck from the internet as someone else had already figured this could prove usefull. What I want to do now is add another colum in the excel file (named ID) and show the layer names with which these points are associated with!

    I've gotten the code done to the following but keep running into problems for returning the layer names into the excel files (am I using the wrong strings here?). Any help would be greatly appreciated!

    Sub ExportPointsToExcel()
            Const rhPoint = 1
     
            Dim arrPoints
            arrPoints = Rhino.GetObjects("Select points to export", rhPoint, True, True)
            If Not IsArray(arrPoints) Then Exit Sub
     
            Dim objXL
            Set objXL = CreateObject("Excel.Application")
     
            objXL.Visible = True
     
            objXL.WorkBooks.Add
     
            objXL.Columns(1).ColumnWidth = 20
            objXL.Columns(2).ColumnWidth = 20
            objXL.Columns(3).ColumnWidth = 20
            objXL.Columns(4).ColumnWidth = 20
     
            objXL.Cells(1, 1).Value = "ID"
            objXL.Cells(1, 2).Value = "X"
            objXL.Cells(1, 3).Value = "Y"
            objXL.Cells(1, 4).Value = "Z"
     
            objXL.Range("A1:D1").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 strPoint, arrPt, arrLayer, strLayer
            For Each strPoint In arrPoints
                    arrPt = Rhino.PointCoordinates(strPoint)
                    objXL.Cells(intIndex, 2).Value = arrPt(0)
                    objXL.Cells(intIndex, 3).Value = arrPt(1)
                    objXL.Cells(intIndex, 4).Value = arrPt(2)
                    intIndex = intIndex + 1
            Next
            For Each strLayer In arrLayers
                    arrLa = Rhino.LayerIds(strLayer)
                    objXL.Cells(intIndex, 1).Value = arrLa(0)
                    intIndex = intIndex + 1
            Next
    End Sub
Recommend

Why are these buttons gray?