Hi,
I'm looking for a way to automate these steps in Corel. We use a vinyl cutter to cut peoples names, but they all have to be a certain size. For example if the name is 4 letters it will be 230 x 50 mm, 5 letters would be 250 x 50 mm, and 6 letters is 260mm and so on.
Usually we have multiple names at the one time, and have to resize each name individually, apply a no fill and then a hairline stroke, then flip it horizontally for cutting purposes.
Do you think its possible to minimize the time taken to do all these names using a script and does anyone know where we could get something like this specially made where you would just enter all the names and it would size them depending on the number of letters, and then apply no fill, outline, and mirror.
Our process right now is
Step 1) Type the name out in Arial Black
Step 2) Resize in mm
Step 3) Apply no fill and a black hairline outline
Step 4) Mirror horizontally
once i have one name typed out i will copy and paste it, type over it but you will always have to resize this. I've tried creating templates for how many letters there are in a name but because the letters vary in size, it never stays the same and you always have to make minimal adjustments.
Any help with this would be greatly appreciated
You could improve things a lot even if you just had a macro to set the width of each text shape based on the number of characters. The other operations can be performed fairly quickly on multiple shapes using regular CorelDRAW tools, styles, or existing macros.
Do you have a list showing the widths for names based on the number of characters, for example:
4 chars = 230 mm
5 chars = 250 mm
6 chars = 260 mm?
And yes, the whole process could probably be automated using a macro. I'm just thinking about what I consider to be the most important part of it.
Yes you're definitely right the most important part of it would be the resizing . I think I have tried creating individual macros for each number of characters available but wasn't able to get it to work.
The full sizes are
2 characters: 120 x 50 mm
3 characters: 180 x 50 mm
4 characters: 210 x 50 mm
5 characters: 230 x 50 mm
6 characters = 250 x 50 mm
7 or more characters: 270 x 50 mm
This is something quick-and-dirty:
Sub resize_by_num_char() Dim sr As ShapeRange Dim s As Shape Dim dblWidthMillimeters As Double Const dblHeightMillimeters As Double = 50 Set sr = ActiveSelectionRange For Each s In sr If s.Type = cdrTextShape Then If s.Text.IsArtisticText Then If s.Text.Story.Characters.Count > 1 Then Select Case s.Text.Story.Characters.Count Case 2 dblWidthMillimeters = 120 Case 3 dblWidthMillimeters = 180 Case 4 dblWidthMillimeters = 210 Case 5 dblWidthMillimeters = 230 Case 6 dblWidthMillimeters = 250 Case Else dblWidthMillimeters = 270 End Select s.SetSize ActiveDocument.ToUnits(dblWidthMillimeters, cdrMillimeter), ActiveDocument.ToUnits(dblHeightMillimeters, cdrMillimeter) End If End If End If Next s End Sub
That works on multiple selected Artistic text shapes.
If that does what you need functionally, then it could easily be polished a little bit.
I really appreciate your help with this, never knew you could put all sizes into the one macro!
Will need to wait until i get into work on Monday to see if this works. Will keep you updated, thanks again
This version has some changes. It has some error handling, and it wraps up all operations so that they show up as a single entry in the Undo list in CorelDRAW.
I've also added lines to:
Sub Resize_by_Char_Count() Dim sr As ShapeRange Dim s As Shape Dim dblWidthMillimeters As Double Const dblHeightMillimeters As Double = 50 Dim blnHaveCommandGroup As Boolean On Error GoTo ErrHandler If Not ActiveDocument Is Nothing Then EventsEnabled = False Optimization = True ActiveDocument.BeginCommandGroup "Resize by Char Count" blnHaveCommandGroup = True Set sr = ActiveSelectionRange For Each s In sr If s.Type = cdrTextShape Then If s.Text.IsArtisticText Then If s.Text.Story.Characters.Count > 1 Then Select Case s.Text.Story.Characters.Count Case 2 dblWidthMillimeters = 120 Case 3 dblWidthMillimeters = 180 Case 4 dblWidthMillimeters = 210 Case 5 dblWidthMillimeters = 230 Case 6 dblWidthMillimeters = 250 Case Else dblWidthMillimeters = 270 End Select s.SetSize ActiveDocument.ToUnits(dblWidthMillimeters, cdrMillimeter), ActiveDocument.ToUnits(dblHeightMillimeters, cdrMillimeter) 'Set no fill s.Fill.ApplyNoFill 'Set outline to hairline s.Outline.Width = ActiveDocument.ToUnits(762, cdrTenthMicron) 'Flip horizontally s.Flip cdrFlipHorizontal End If End If End If Next s Else MsgBox "No document is active.", vbInformation, "Resize by Char Count" End If ExitSub: If blnHaveCommandGroup Then ActiveDocument.EndCommandGroup Optimization = False EventsEnabled = True Refresh End If Exit Sub ErrHandler: MsgBox "Error occurred: " & Err.Description Resume ExitSub End Sub
Here's a demonstration:
Here's a link to a .ZIP file that has the .GMS file in it:
JQ_Resize_by_Char_Count_Current.zip.
I've managed to use this and it works perfectly. This will save us a lot of time. Thanks a lot for you help!
From your macro I'm trying to create a macro that will just do the last part, flip horizontallly and add a hairline stroke to any objects or text, I'm trying to edit but it only works for text. Do you know what I need to add in?
Sub FlipOutline()
Dim sr As ShapeRangeDim s As ShapeDim blnHaveCommandGroup As Boolean On Error GoTo ErrHandler If Not ActiveDocument Is Nothing Then EventsEnabled = False Optimization = True ActiveDocument.BeginCommandGroup "FlipOutline" blnHaveCommandGroup = True Set sr = ActiveSelectionRange For Each s In sr If s.Type = cdrTextShape Then If s.Text.IsArtisticText Then 'Set no fill s.Fill.ApplyNoFill 'Set outline to hairline s.Outline.Width = ActiveDocument.ToUnits(762, cdrTenthMicron) 'Flip horizontally s.Flip cdrFlipHorizontal End If End If End If Next s Else MsgBox "No document is active.", vbInformation, "FlipOutline" End If
ExitSub: If blnHaveCommandGroup Then ActiveDocument.EndCommandGroup Optimization = False EventsEnabled = True Refresh End If Exit Sub
ErrHandler: MsgBox "Error occurred: " & Err.Description Resume ExitSubEnd Sub