' Script for Rhinoceros V4 ' copy multiple objects to Points, Group of Points or PointCloudPoints ' © 2008 Clement Greiner Sub CopyObjectsToPoints Dim arrSource ' source objects to copy Dim arrBase ' base point to copy from Dim arrObjects ' picked destination objects Dim strObject ' single destination object Dim arrEnd ' destination coordinate Dim StrResult ' a single result object Dim arrPtCloud ' the array of pointcloudpoints Dim i Dim blnRandomRotation Rhino.Print "CopyObjectsToPoints_RH4.rvb loaded." arrSource = Rhino.GetObjects("Select Objects to to be copied", ,vbTrue, vbTrue, vbFalse) If IsArray(arrSource) Then arrBase = Rhino.GetPoint("Select a base Point to copy Objects from") If IsArray(arrBase) Then arrObjects = Rhino.GetObjects("Select Points, Groups of Points or PointClouds to copy to", , vbTrue, vbFalse, vbFalse) If Not IsArray(arrObjects) Then Rhino.Print "Command canceled." Exit Sub Else blnRandomRotation = Rhino.GetString("Add random Z-Axis Rotation ?", "No", Array("Yes", "No")) If blnRandomRotation = "Yes" Then blnRandomRotation = True Else blnRandonRotation = False Rhino.EnableRedraw vbFalse ' process all objects For Each strObject In arrObjects ' copy objects to points or points in a group If Rhino.IsPoint(strObject) Then ' Get the Point coordinate of the selected Point arrEnd = Rhino.PointCoordinates(StrObject) ' Copy source objects to point using base point and dest. coordinates StrResult = Rhino.CopyObjects(arrSource, arrBase, arrEnd) If blnRandomRotation = True Then Rhino.RotateObjects StrResult, arrEnd, Rnd(1)*360, ,vbFalse ' keep the result selected Rhino.SelectObjects(StrResult) End If ' copy objects to pointcloud points If Rhino.IsPointCloud(strObject) Then ' get all points in the cloud arrPtCloud = Rhino.PointCloudPoints(strObject) For i = 0 To UBound(arrPtCloud) StrResult = Rhino.CopyObjects(arrSource, arrBase, arrPtCloud(i)) If blnRandomRotation = True Then Rhino.RotateObjects StrResult, arrPtCloud(i), Rnd(1)*360, ,vbFalse Next End If Next Rhino.EnableRedraw vbTrue End If End If End If End Sub CopyObjectsToPoints