Pack Rhino Objects

One Block Per Layer – RhinoScripting

Yesterday evening,we were exporting a Rhino model (containing mainly meshes) to SketchUp. We used DWG as translation format and the resulting model was a soup of triangles, so we thought it would be a good idea to pack every layer in our Rhino model into a block so SketchUp would convert each block into a component.

This would isolate the edges of each object from those in other layers and make selection more convenient.  Instead of spending 10 minutes packing each of the 20 layers our file had, we thought we could write a script to do so for us. In the end it took us more than expected as my RhinoScripting is a bit (maybe a lot) rusty.

Here is the code, you can copy and paste it in a new file or, if feeling lazy, just download the file.

Option Explicit
'Script written by Roberto Molinos @robertomolinos
'Script copylefted by Modelical // free to use, improve and share
'Script version Friday, 21 March 2014 19:58:18

Call Layers2Blocks()
Sub Layers2Blocks()

	Dim strFile
	Dim arrLayers, strLayer, strBlock
	Dim arrSelected, arrPoint

	' Get names of all layers
	arrLayers = Rhino.LayerNames

	' Disable redrawing
	Rhino.EnableRedraw False

	' Process each layer
	For Each strLayer In arrLayers

		' Unselect all  
		Rhino.Command "_-SelNone", 0

		' Select all objects on layer. Surround layer name
		' with double-quotes in case it includes spaces.
		Rhino.Command "_-SelLayer " & Chr(34) & strLayer & Chr(34), 0

		' Make sure some objects were selected
		arrSelected = Rhino.SelectedObjects
		If IsArray(arrSelected) Then

			'Create insertion point at 0,0,0
			arrPoint = Array(0, 0, 0)
			'Set current layer so block is created on the same one
			Call Rhino.CurrentLayer(strLayer)
                        'Create block
			strBlock = Rhino.AddBlock(arrSelected, arrPoint, strLayer, True)
			'Delete objects as they are now in the block
			Call Rhino.DeleteObjects(arrSelected)
                        'Insert the block
			Call Rhino.InsertBlock(strBlock, arrPoint)

		End If
		' Unselect all
		Rhino.Command "_-SelNone", 0
	Next

	' Unselect all
	Rhino.Command "_-SelNone", 0

	' Enable redrawing
	Rhino.EnableRedraw True
End Sub

This post was inspired by a similiar one in the McNeel Wiki – ExportLayerObjects