' Creates a new layer structure "Production::Pieces", with curves ready for ' production. ' Felix E. Klee Option Explicit Rhino.Command "_-LoadScript common.rvb" MyPrepareProduction Sub MyMakeLayersVisible(layers, toBeVisible) Dim layer For Each layer In layers If Not Rhino.IsLayerCurrent(layer) Then Rhino.LayerVisible layer, toBeVisible End If Next End Sub Sub MyHideOtherLayers MyMakeLayersVisible Rhino.LayerNames, False End Sub Sub MyShowOnlyProductionLayers Rhino.CurrentLayer "Production" MyHideOtherLayers MyMakeLayersVisible Rhino.LayerChildren("Production"), True End Sub Sub MyMake2D(layer) Rhino.Command "_-Make2D DrawingLayout=CurrentCPlane " & _ "ShowTangentEdges=No " & _ "CreateHiddenLines=No MaintainSourceLayers=No " & _ "VisibleLineLayer """ & layer & """ _Enter " & _ "_Enter", False End Sub Sub CopyWithoutDuplicateCurves(srcLayer, destLayer) Dim srcObjects, destObjects Rhino.LayerVisible srcLayer, True srcObjects = Rhino.ObjectsByLayer(srcLayer) If IsNull(srcObjects) Then Exit Sub End If Rhino.UnselectAllObjects Rhino.SelectObjects(srcObjects) MyMake2D destLayer ' removes duplicates destObjects = Rhino.ObjectsByLayer(destLayer) Rhino.joinCurves destObjects, True End Sub Sub MySplitWithCircles(circles) Rhino.UnselectAllObjects Rhino.SelectObjects(circles) Rhino.InvertSelectedObjects Rhino.Command "_Split _SelAll _Enter", False End Sub Function MyAddCircleAtPoint(point, radius) Dim plane plane = Rhino.PlaneFromFrame(Rhino.PointCoordinates(point), _ Array(1, 0, 0), _ Array(0, 1, 0)) MyAddCircleAtPoint = Rhino.AddCircle(plane, radius) End Function Function MyAddCirclesAtPoints(points, radius) Dim i ReDim circles(UBound(points)) For i = 0 To UBound(points) circles(i) = MyAddCircleAtPoint(points(i), radius) Next MyAddCirclesAtPoints = circles End Function Sub MyMoveSmallToCreaseLayer(diameter) Dim boundingBoxDiag, crease boundingBoxDiag = Sqr(2 * diameter * diameter) Rhino.UnselectAllObjects Rhino.Command "_SelSmall " & boundingBoxDiag & " _Enter", False crease = Rhino.SelectedObjects Rhino.ObjectLayer crease, "Production::Crease" End Sub Sub MyAddCrease Dim arrPlane, points, circles, diameter diameter = Rhino.GetReal("Diameter of cutting circles (needs to be " & _ "smaller than any other feature)", 0.2, 0) Rhino.CurrentLayer "Pieces::Crease" MyHideOtherLayers points = Rhino.ObjectsByType(1, False, 1) If IsNull(points) Then Exit Sub End If circles = MyAddCirclesAtPoints(points, diameter / 2) Rhino.CurrentLayer "Production::Cut" MySplitWithCircles circles Rhino.DeleteObjects circles MyMoveSmallToCreaseLayer(diameter) End Sub Sub MyAddOutline CopyWithoutDuplicateCurves "Pieces::Outline", "Production::Outline" End Sub Sub MyAddCut CopyWithoutDuplicateCurves "Pieces::Cut", "Production::Cut" End Sub Sub MyAddMark CopyWithoutDuplicateCurves "Pieces::Mark", "Production::Mark" End Sub Sub MyRecreateProductionLayers Rhino.CurrentLayer "Pieces" Rhino.PurgeLayer "Production::Outline" Rhino.PurgeLayer "Production::Cut" Rhino.PurgeLayer "Production::Mark" Rhino.PurgeLayer "Production::Crease" Rhino.PurgeLayer "Production" Rhino.AddLayer "Production", RGB(255, 255, 255) Rhino.AddLayer "Outline", RGB(0, 0, 0), , , "Production" Rhino.AddLayer "Cut", RGB(255, 0, 0), , , "Production" Rhino.AddLayer "Mark", RGB(0, 0, 255), , , "Production" Rhino.AddLayer "Crease", RGB(51, 102, 153), , , "Production" End Sub ' For smoother export, see: (2015-10-13 CEST) Sub MyConvertToBeziers(layer) Rhino.CurrentLayer layer Call MyHideOtherLayers Rhino.Command "_SelNone" Rhino.Command "_SelAll" Rhino.Command "_ConvertToBeziers Yes" Rhino.Command "_SelNone" Rhino.Command "_SelAll" Rhino.Command "_Join" End Sub Sub MyConvertProductionToBeziers MyConvertToBeziers("Production::Outline") MyConvertToBeziers("Production::Cut") MyConvertToBeziers("Production::Mark") End Sub Sub MyShowChildLayersOfPieces MyMakeLayersVisible Rhino.LayerChildren("Pieces"), True End Sub Sub MyCleanUp Rhino.UnselectAllObjects MyShowOnlyProductionLayers MyShowChildLayersOfPieces End Sub Sub MyPrepareProduction Rhino.CurrentView("Top") MyRecreateProductionLayers MyAddOutline MyAddCut MyAddMark MyAddCrease MyConvertProductionToBeziers MyCleanUp End Sub