Hi, all!
Thought this might be interesting to some of you (ideally there could be interaction to improve things). When working with shape layouts for cutting or other tasks where material is important sometimes even decent nesting systems leave strange gaps, not to mention when you just want to arrange things yourself. It takes forever. I ran into this again recently and thought: "What if there was a tool that could react to a series of commands and do the things normally done by hand?"
Lo and behold, CNL was born! Here's a demonstration:
Basically you select some (curve) shapes, enter a series of commands and watch the magic happen.
Here's the updated code:
Option Explicit Sub Demo() CNL "" End Sub Sub CNL(Optional ByVal Commands As String) '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-> ' CNL is a "scriptable nesting system" that basically just pushes shapes ' around until a limit is reached, then does the next step. ' Currently simple push commands are supported, but, in theory, all sorts ' of mildly stupid things could be added (colors, per-shape user entries etc). On Error GoTo ErrorOccured 'Do we even have a document? If ActiveDocument Is Nothing Then MsgBox "Please have a document open!", vbOKOnly Or vbExclamation, " CNL" Exit Sub End If 'Anything selected? If ActiveSelectionRange.Count = 0 Then MsgBox "No shapes selected!", vbOKOnly Or vbExclamation, " CNL" Exit Sub End If 'Enter the script Dim Sequence() As String, Entry As Variant, A As Long If Commands = "" Then Entry = InputBox("Enter the command sequence to push shapes around, like DLDRD, or 2FD. Just a line of characters" & vbNewLine & vbNewLine & "Possible commands:" & vbNewLine & _ "L = Push Left" & vbNewLine & _ "R = Push Right" & vbNewLine & _ "U = Push Up" & vbNewLine & _ "D = Push Down" & vbNewLine & _ "F = Flip - Rotate 180 degrees" & vbNewLine & _ "C or V = Arrange in a Column (Vertically)" & vbNewLine & _ "H = Arrange in a Row (Horizontally)" & vbNewLine & _ "1-9 = Select every Nth Shape", " Enter the command sequence") Else Entry = Commands End If If Entry = "" Then MsgBox "No sequnce = no result!", vbOKOnly Or vbExclamation, " CNL" Exit Sub End If Entry = UCase(Entry) Dim PushStep As Double, PageMargin As Double PushStep = 7 PageMargin = 21 - PushStep / 2 ReDim Sequence(Len(Entry) - 1) For A = 1 To Len(Entry) Sequence(A - 1) = Mid$(Entry, A, 1) Next A '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-> ' Here we go boostStart "CNL" ActiveDocument.Unit = cdrMillimeter Dim OriginalShapes As New ShapeRange, WorkShapes As ShapeRange, AllShapes As ShapeRange, TempWorkShapes As New ShapeRange, TempShapes As New ShapeRange Set WorkShapes = ActiveSelectionRange Set AllShapes = ActivePage.Shapes.All 'If ALL the shapes are selected then the regular shape range is not needed If WorkShapes.Count < AllShapes.Count Then AllShapes.RemoveRange WorkShapes Else AllShapes.RemoveAll End If Dim TempShape As Shape, WorkShape As Shape 'Create boundaries for all the shapes (necessary for groups etc) For Each WorkShape In AllShapes 'Set TempShape = WorkShape.CreateBoundary(0, 0, True) Set TempShape = WorkShape.CreateContour(cdrContourOutside, PushStep * 0.49, 1, , , , , , , cdrContourRoundCap, cdrContourCornerRound).Separate.Shapes.First If Not TempShape Is Nothing Then TempShapes.Add TempShape Else ActiveWindow.ActiveView.ToFitShape WorkShape End If Next WorkShape If AllShapes.Count > 0 Then AllShapes.Hide End If 'Add a "margin" (countour) around the shapes so they can sense overlapping and keep a distance For Each WorkShape In WorkShapes Set TempShape = WorkShape.CreateContour(cdrContourOutside, PushStep * 0.49, 1, , , , , , , cdrContourRoundCap, cdrContourCornerRound).Separate.Shapes.First TempShape.Name = WorkShape.StaticID TempWorkShapes.Add TempShape Next WorkShape Debug.Print TempWorkShapes.Count OriginalShapes.AddRange TempWorkShapes 'Hide the base shapes so we only use their expanded copies WorkShapes.Hide Dim ShapeStep As Integer, TempValue As Double 'Read our split lines to come up with commands For Each Entry In Sequence 'Sort shapes depending on method Select Case Entry Case "L" TempWorkShapes.Sort "@shape1.Left < @shape2.Left" Case "R" TempWorkShapes.Sort "@shape1.Right > @shape2.Right" Case "U" TempWorkShapes.Sort "@shape1.Top > @shape2.Top" Case "D" TempWorkShapes.Sort "@shape1.Bottom < @shape2.Bottom" '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-> Case "V", "C" TempValue = TempWorkShapes.BottomY TempWorkShapes.Sort "@shape1.Bottom < @shape2.Bottom" For Each WorkShape In TempWorkShapes WorkShape.BottomY = TempValue WorkShape.LeftX = TempWorkShapes.LeftX TempValue = TempValue + WorkShape.SizeHeight + PushStep Next WorkShape GoTo SkipStep '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-> Case "H" TempValue = TempWorkShapes.LeftX TempWorkShapes.Sort "@shape1.Left < @shape2.Left" For Each WorkShape In TempWorkShapes WorkShape.LeftX = TempValue WorkShape.BottomY = TempWorkShapes.BottomY TempValue = TempValue + WorkShape.SizeWidth + PushStep Next WorkShape GoTo SkipStep End Select For Each WorkShape In TempWorkShapes '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-> Select Case Entry Case 1, 2, 3, 4, 5, 6, 7, 8, 9 TempWorkShapes.RemoveAll If Entry = 1 Then TempWorkShapes.AddRange OriginalShapes Else For ShapeStep = 1 To OriginalShapes.Count If ShapeStep Mod Entry = 0 Then TempWorkShapes.Add OriginalShapes(ShapeStep) OriginalShapes(ShapeStep).Fill.ApplyUniformFill CreateRGBColor(255, 0, 0) End If Next ShapeStep End If GoTo SkipStep End Select '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-> Select Case Entry Case "L" Do WorkShape.Move -WorkShape.SizeWidth / 2, 0 Loop Until ShapesOverlapped(WorkShape) Or WorkShape.LeftX < ActivePage.LeftX + PageMargin WorkShape.Move WorkShape.SizeWidth / 2, 0 Do WorkShape.Move -PushStep, 0 Loop Until ShapesOverlapped(WorkShape) Or WorkShape.LeftX < ActivePage.LeftX + PageMargin WorkShape.Move PushStep, 0 Do WorkShape.Move -1, 0 Loop Until ShapesOverlapped(WorkShape) Or WorkShape.LeftX < ActivePage.LeftX + PageMargin WorkShape.Move 1, 0 '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-> Case "R" Do WorkShape.Move WorkShape.SizeWidth / 2, 0 Loop Until ShapesOverlapped(WorkShape) Or WorkShape.RightX > ActivePage.RightX - PageMargin WorkShape.Move -WorkShape.SizeWidth / 2, 0 Do WorkShape.Move PushStep, 0 Loop Until ShapesOverlapped(WorkShape) Or WorkShape.RightX > ActivePage.RightX - PageMargin WorkShape.Move -PushStep, 0 Do WorkShape.Move 1, 0 Loop Until ShapesOverlapped(WorkShape) Or WorkShape.RightX > ActivePage.RightX - PageMargin WorkShape.Move -1, 0 '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-> Case "D" Do WorkShape.Move 0, -WorkShape.SizeHeight / 2 Loop Until ShapesOverlapped(WorkShape) Or WorkShape.BottomY < ActivePage.BottomY + PageMargin WorkShape.Move 0, WorkShape.SizeHeight / 2 Do WorkShape.Move 0, -PushStep Loop Until ShapesOverlapped(WorkShape) Or WorkShape.BottomY < ActivePage.BottomY + PageMargin WorkShape.Move 0, PushStep Do WorkShape.Move 0, -1 Loop Until ShapesOverlapped(WorkShape) Or WorkShape.BottomY < ActivePage.BottomY + PageMargin WorkShape.Move 0, 1 '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-> Case "U" Do WorkShape.Move 0, WorkShape.SizeHeight / 2 Loop Until ShapesOverlapped(WorkShape) Or WorkShape.TopY > ActivePage.TopY - PageMargin WorkShape.Move 0, -WorkShape.SizeHeight / 2 Do WorkShape.Move 0, PushStep Loop Until ShapesOverlapped(WorkShape) Or WorkShape.TopY > ActivePage.TopY - PageMargin WorkShape.Move 0, -PushStep Do WorkShape.Move 0, 1 Loop Until ShapesOverlapped(WorkShape) Or WorkShape.TopY > ActivePage.TopY - PageMargin WorkShape.Move 0, -1 '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-> Case "F" WorkShape.Rotate 180 End Select Next WorkShape SkipStep: Next Entry '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-> ' Deal with the processed shapes If AllShapes.Count > 0 Then AllShapes.Show End If If WorkShapes.Count > 0 Then WorkShapes.Show End If 'Find the parent shapes from their expanded clones and replace For Each WorkShape In TempWorkShapes If Not ActivePage.FindShape(, , WorkShape.Name) Is Nothing Then With ActivePage.FindShape(, , WorkShape.Name) .CenterX = WorkShape.CenterX .CenterY = WorkShape.CenterY If WorkShape.RotationAngle = 180 Then .Rotate 180 End If End With End If Next WorkShape 'Cleanup OriginalShapes.Delete TempShapes.Delete WorkShapes.CreateSelection Success: boostFinish True Exit Sub ErrorOccured: MsgBox "A critical Error occurred: " & vbCrLf & Err.Description, 16, "Critical error!" Err.Clear Resume Success End Sub Sub boostStart(Optional unDo$) On Error Resume Next 'Thanks for the cursor, Shelby! CorelScriptTools.BeginWaitCursor If Len(unDo) Then ActiveDocument.BeginCommandGroup unDo Optimization = True EventsEnabled = False ActiveDocument.SaveSettings ActiveDocument.PreserveSelection = False End Sub Sub boostFinish(Optional ByVal endUndoGroup As Boolean = False) On Error Resume Next ActiveDocument.PreserveSelection = True ActiveDocument.RestoreSettings EventsEnabled = True Optimization = False If endUndoGroup Then ActiveDocument.EndCommandGroup ActiveWindow.Refresh End Sub
You get an explanation on usage when the Input Box is called, so have fun. Currently the distance between the shapes is hardcoded to 7mm. But it's easy to change, just find the PushStep variable.
I guess you are showing that it can be better. And, of course, it can. Obviously this is not some proper 'nesting system', but more of a fun experiment with VBA. Still, can be useful at times. And, if we assume that only 180 degree turns are allowed that demonstration layout isn't half bad
PS. Did you actually cut out the shapes from a screenshot of the video to show how to nest them better? I am impressed and scared at the same time
just drew three shapes on top of your picture, painted, quickly copied and scattered them
Well, the thing here is the user needs to figure out the best approach. But once it is known things are easy. For example, if we wanted your "on top of one another" approach:
Quite likely a lot faster to just type a couple of letters than doing this by hand. Also, thanks to you I thought of some options to make it work better.
by the way, all your commands end with the letter d (push down). I think, you could make it the default. Like tetris
Hehe. Well, that is just for these simple demos. But in more realistic use it isn't always the case. Anyway, I optimized the process by pre-sorting the shapes into rows or columns so it almost always gets processed in proper sequence and also added row and column modes. Code has been updated.
Hi Joe,
Your code looks pretty interesting but I'm unable to test it. The definition of the function "ShapesOverlapped" appears to be missing. Where can I find this so that I can try it out?
ThanksRic