Option Explicit 'Script written by 'Script copyrighted by 'Script version Wednesday, 29 July 2015 14:31:58 Call Main() Sub Main() Dim FileName, file, excel FileName = Rhino.OpenFileName("Select Excel File", "Excel Files (*.xlsx)|*.xlsx||") If isNull(FileName) Then Exit Sub Set excel = CreateObject("Excel.Application") excel.Workbooks.Open(FileName) Set file = excel.ActiveSheet Call Rhino.EnableRedraw(False) Dim strRng, rng Dim i Dim RoomName(), RoomArea(), RoomRatio(), RoomHeight() For i = 2 To 1000 'put here the range of cells to look at strRng = "A" & i 'column of the values to insert Set rng = file.Range(strRng) If rng.value = "<>" Then Exit For End If ReDim Preserve RoomName(i-2) 'if first cell not 0, change to first cell # RoomName(i - 2) = rng.value strRng = "B" & i Set rng = file.Range(strRng) ReDim Preserve RoomArea(i-2) RoomArea(i - 2) = rng.value strRng = "C" & i Set rng = file.Range(strRng) ReDim Preserve RoomRatio(i-2) RoomRatio(i - 2) = rng.value strRng = "D" & i Set rng = file.Range(strRng) ReDim Preserve RoomHeight(i-2) RoomHeight(i - 2) = rng.value Next Dim PT0, PT1, PT2, PT3, PT4, PT5, PT6, PT7 PT0 = Array(0, 0, 0) PT1 = Array(0, 0, 0) PT2 = Array(0, 0, 0) PT3 = Array(0, 0, 0) PT4 = Array(0, 0, 0) PT5 = Array(0, 0, 0) PT6 = Array(0, 0, 0) PT7 = Array(0, 0, 0) Dim width, length, Arr_box, Box, Tag For i = 0 To Ubound(RoomName) width = SQR(RoomArea(i)) length = width * RoomRatio(i) width = length / RoomRatio(i) PT1 = Array(PT0(0) + length, PT0(1), 0) PT2 = Array(PT0(0) + length, PT0(1) + width, 0) PT3 = Array(PT0(0), PT0(1) + width, 0) PT4 = Array(PT0(0), PT0(1), RoomHeight(i)) PT5 = Array(PT0(0) + length, PT0(1), RoomHeight(i)) PT6 = Array(PT0(0) + length, PT0(1) + width, RoomHeight(i)) PT7 = Array(PT0(0), PT0(1) + width, RoomHeight(i)) Arr_box = Array(PT0, PT1, PT2, PT3, PT4, PT5, PT6, PT7) Box = Rhino.AddBox(Arr_box) Tag = Rhino.AddTextDot(RoomName(i), PT0) Call Rhino.AddGroup(RoomName(i)) Call Rhino.AddObjectsToGroup(Array(Box, Tag), RoomName(i)) PT0(0) = PT0(0) + length + 1 Next ' Close the workbook without saving Call excel.ActiveWorkbook.Close(False) ' Quit Excel excel.Application.Quit Call Rhino.MessageBox("The Rooms were successfully imported") Call Rhino.EnableRedraw(True) End Sub