Skip to content


Subversion checkout URL

You can clone with
Download ZIP
Branch: master
Fetching contributors…

Cannot retrieve contributors at this time

54 lines (41 sloc) 1.62 KB
' CopyObjectsToLayer.rvb -- May 2012
' 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
' Subroutine: CopyObjectsToLayer
' Purpose: Copy selected objects to a different layer.
Sub CopyObjectsToLayer
Dim arrObjects, arrLayers, strLayer, arrNew, strNew
' Get the objects to copy
arrObjects = Rhino.GetObjects("Select objects")
If IsArray(arrObjects) Then
' Make sure select objects are unselected
Rhino.UnselectObjects arrObjects
' Get all layer names
arrLayers = Rhino.LayerNames
If IsArray(arrLayers) Then
' Get the destination layer
arrLayers = Rhino.Sort(arrLayers)
strLayer = Rhino.ComboListBox(arrLayers, "Destination Layer " & "<" & Rhino.CurrentLayer & ">")
If Not IsNull(strLayer) Then
' Add the new layer if necessary
If Not Rhino.IsLayer(strLayer) Then Rhino.AddLayer(strLayer)
' Copy the objects
arrNew = Rhino.CopyObjects(arrObjects)
If IsArray(arrNew) Then
For Each strNew In arrNew
' Set the layer of the copied objects
Rhino.ObjectLayer strNew, strLayer
End If
' Select the newly copied objects
Rhino.SelectObjects arrNew
End If
End If
End If
End Sub
Jump to Line
Something went wrong with that request. Please try again.