I made CNL... Corel Nesting Language ;)

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.

Parents Reply Children
No Data