rhinoceros

来自「Rhinoceros犀牛(Rhino) v4.0多种语言（含中文版）」· 代码 · 共 36 行

''' ------------------------------------------------------------
''' RhinoScript 3.0 Sample Code
''' 2002, Robert McNeel & Associates
'''
''' CopyObjectsToLayer.rvb
''' ------------------------------------------------------------
Option Explicit

''' ------------------------------------------------------------
''' Subroutine:  CopyObjectsToLayer
''' Purpose:     Copy selected objects to a different layer.
''' ------------------------------------------------------------
Sub CopyObjectsToLayer()
	Dim arrObjects, arrLayers, strLayer, arrNew, strNew
	arrObjects = Rhino.GetObjects("Select objects")
	If IsArray(arrObjects) Then
		Rhino.UnselectObjects arrObjects
		arrLayers = Rhino.LayerNames
		If IsArray(arrLayers) Then
			arrLayers = Rhino.Sort(arrLayers)
			strLayer = Rhino.ComboListBox(arrLayers, "Destination Layer " & "<" & Rhino.CurrentLayer & ">")
			If strLayer <> vbNull Then
				If Not Rhino.IsLayer(strLayer) Then Rhino.AddLayer(strLayer)
				arrNew = Rhino.CopyObjects(arrObjects)
				If IsArray(arrNew) Then
					For Each strNew In arrNew
						Rhino.ObjectLayer strNew, strLayer
					Next
				End If
				Rhino.SelectObjects arrNew
			End If
		End If
	End If
End Sub