Since I’ve started providing small format art reproduction services, doing page layouts for printing has become a chore. Each piece is a different size and needs a little different handling, so none of the print layout options built into the programs I use was working. Manually laying out printer margins, spacing, and then crop marks for cutting, then duplicating across different page sizes was eating up a lot of time.

So I spent some time working out a little script help to make this tedious task much easier!

This allows me to set up the sheet size the client wants, import an image that has gone through the digitizing process (or one a client provides), place it in the lower left corner and trigger a few scripts to populate the page with proper spacing and crop marks! It’s still a little bit of work to set each new sheet up, but this leaves me with a file that I can reprint any time the client wants instead of having to play with printer layouts every time!

How to use:

Open CorelDRAW.

Go to Tools/Scripts/Script Editor.This will open Microsoft Visual Basic for Applications.

Right click on Global Macros. Select Insert/Module.

You will see a new navigation entry under Modules and a new window will open up. Paste the at the bottom of this post into that window.

Go back into CorelDRAW and open the scripts docker.

Find the scripts you just added under Visual Basic for Applications/Global Macros/Module 1 (or whatever module number you just added).

To use the script, place an object (in this case a bitmap) in the lower left corner of the document. For some reason that is CorelDRAW’s origin instead of the upper left, lol.

Make sure the bitmap is selected, click on the script ‘PopulatePageFromBottomLeft’ and click the green Play button at the bottom of the docker. This will duplicate the the object across the whole page with 1/8 inch between each object. This works for any size page and any size object!

After the page is populated, select all of the bitmaps, click on the script ‘BitmapCropMarks’ and then the Play button again. This can take a few seconds if there are a lot of bitmaps to make crop marks for, but at the end it will create crop marks underneath the bitmaps (so they don’t print on top of the image you are needing to cut out)! This also works for a single bitmap, doesn’t have to be multiple ones like these!

Tada! A full sheet layout ready to save and print any time it’s needed =D

Code:

Sub PopulatePageFromBottomLeft()
    Dim sr As ShapeRange
    Dim originalShape As Shape
    Dim pageWidth As Double
    Dim pageHeight As Double
    Dim objectWidth As Double
    Dim objectHeight As Double
    Dim xPos As Double
    Dim yPos As Double
    Dim spacing As Double

    ' Define the spacing between objects (in inches)
    spacing = 0.125 ' 1/8 inch spacing

    ' Get the selected object
    Set sr = ActiveSelectionRange
    If sr.Count <> 1 Then
        MsgBox "Please select a single object."
        Exit Sub
    End If

    Set originalShape = sr(1)

    ' Get the dimensions of the selected object
    objectWidth = originalShape.SizeWidth
    objectHeight = originalShape.SizeHeight

    ' Get the dimensions of the page and reduce by 1/2 inch
    pageWidth = ActiveDocument.ActivePage.SizeWidth - 0.5
    pageHeight = ActiveDocument.ActivePage.SizeHeight - 0.5

    ' Set the initial position (bottom left of the page)
    xPos = 0
    yPos = 0

    ' Loop to create and place duplicates
    Do While yPos + objectHeight <= pageHeight
        Do While xPos + objectWidth <= pageWidth
            If Not (xPos = 0 And yPos = 0) Then ' Skip the original object
                originalShape.Duplicate.Move xPos, yPos
            End If
            xPos = xPos + objectWidth + spacing
        Loop
        xPos = 0
        yPos = yPos + objectHeight + spacing
    Loop

    MsgBox "Objects duplicated and laid out on the page from bottom left with 1/8 inch spacing."
End Sub

Sub BitmapCropMarks()
    Dim sr As ShapeRange
    Dim bm As Shape
    Dim x As Double, y As Double, w As Double, h As Double
    Dim offset As Double
    Dim markLength As Double
    Dim i As Integer

    ' Define the offset and length for the crop marks (1/4 inch = 0.25 inches, 1/2 inch = 0.5 inches)
    offset = 0.25 ' Offset in inches
    markLength = 0.5 ' Crop mark length in inches

    ' Get the selected bitmaps
    Set sr = ActiveSelectionRange
    If sr.Count < 1 Then
        MsgBox "Please select one or more bitmaps."
        Exit Sub
    End If

    ' Loop through each selected bitmap
    For i = 1 To sr.Count
        If sr(i).Type = cdrBitmapShape Then
            Set bm = sr(i)

            ' Get the position and size of the bitmap
            x = bm.LeftX
            y = bm.TopY
            w = bm.SizeWidth
            h = bm.SizeHeight

            ' Create crop marks
            Dim cropMarks As New ShapeRange
            ' Top-left
            cropMarks.Add ActiveLayer.CreateLineSegment(x - offset, y, x - offset + markLength, y)
            cropMarks.Add ActiveLayer.CreateLineSegment(x, y + offset, x, y + offset - markLength)
            ' Top-right
            cropMarks.Add ActiveLayer.CreateLineSegment(x + w + offset - markLength, y, x + w + offset, y)
            cropMarks.Add ActiveLayer.CreateLineSegment(x + w, y + offset - markLength, x + w, y + offset)
            ' Bottom-left
            cropMarks.Add ActiveLayer.CreateLineSegment(x - offset, y - h, x - offset + markLength, y - h)
            cropMarks.Add ActiveLayer.CreateLineSegment(x, y - h - offset + markLength, x, y - h - offset)
            ' Bottom-right
            cropMarks.Add ActiveLayer.CreateLineSegment(x + w + offset - markLength, y - h, x + w + offset, y - h)
            cropMarks.Add ActiveLayer.CreateLineSegment(x + w, y - h - offset + markLength, x + w, y - h - offset)

            ' Move crop marks to the back (underneath the bitmap)
            For Each mark In cropMarks
                mark.OrderToBack
            Next mark
        End If
    Next i

    MsgBox "Crop marks added underneath the selected bitmaps."
End Sub