Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 59 lines (42 sloc) 1.587 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ExportLayerObjectsTo3ds.rvb -- June 2007
' 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 ExportLayerObjectsTo3ds
  
  ' 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 & ".3ds")
      
      ' Export the selected objects
      Rhino.Command "_-Export " & strFile & " _Enter", 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.