Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
59 lines (42 sloc) 1.53 KB
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ExportLayerObjects.rvb -- June 2005
' If this code works, it was written by Dale Fugier.
' If not, I don't know who wrote it.
' Works with Rhino 4.0.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Sub ExportLayerObjects
' Declare local variables
Dim strPath, strFile
Dim arrLayers, strLayer
Dim arrSelected
' Get the path to and name of the current document.
' Surround with double-quotes in case path includes spaces.
strPath = Chr(34) & Rhino.DocumentPath & Rhino.DocumentName & Chr(34)
' 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
' Generate a modified path string
' that includes the layer name
strFile = strPath
strFile = Replace(strFile, ".3dm", "_" & strLayer & ".3dm")
' Export the selected objects
Rhino.Command "_-Export " & strFile, 0
End If
Next
' Unselect all
Rhino.Command "_-SelNone", 0
' Enable redrawing
Rhino.EnableRedraw True
End Sub
Something went wrong with that request. Please try again.