CorelDraw VBA macro to detect “holes”, very useful for laser cutting complex shapes

For the last two years, we have manually checked and amended customers drawing sto ensure we cut the parts in the right order, i.e. the inside 1st.
Typical example is with letters like O, g, e etc.

I finally decided to tackle this issue to optimize productivity, reduce manual errors and allow our team to do more value-added of their precious time.

Good thing with CorelDraw is you can program your own macros in VBA, quite extensive sets of objects, pethods and properties, and reasonable performance.
Looking over internet, I found I was not the only one searching for this, but only a few full commercial solution were available.

So I coded it myself. Find below my 1st attempt.
Seems to work OK for only one level of inside shapes [by design] .
Will improve it when get more free time since most of our case are one level only so should solve the issue of my operator in 95% of the cases.

Here is an example: 

The main steps are:
1st stage:
- ungroup
- convert to curves
- break apart

2nd stage:
- parse all shapes and check if they intersect with eachother. If they intersect then either their intersection is equal to one of them i.e. this one is the fully included i.e. the hole, or the opposite, or it’s a real intersect that I don’t handle for now

3rd stage:
- in my case I change the outline color since this is used by the laser cutter to determine the order. Feel free to change to your own need.

Minimal error checking, no user interface for now.

Code:
Private Function POutlineInsideCurves(rangeToParse As ShapeRange, insideColor As Color) As ShapeRange

Dim s As Shape
Dim ss As Shape
Dim si As Shape
Dim sBreak As ShapeRange

Dim sCurves As New ShapeRange
Dim results As New ShapeRange

Dim i As Integer
Dim j As Integer
Dim count As Integer

‘Ungroup all 1st
Set rangeToParse = rangeToParse.UngroupAllEx

‘ Parse all shapes, put them as curves and break them
For Each s In rangeToParse
Select Case s.Type
Case cdrCurveShape
Case cdrRectangleShape, cdrEllipseShape
s.ConvertToCurves
Case cdrTextShape
s.ConvertToCurves
Case Else
‘ Should raise an error and display error message here
End Select

Set sBreak = s.BreakApartEx
sCurves.AddRange sBreak
Next s

‘ Parse all broken shapes and find which are insides
count = sCurves.count

For i = 1 To count
Set s = sCurves(i)

s.Fill.ApplyNoFill

For j = i + 1 To count
Set ss = sCurves(j)

Set si = s.Intersect(ss, True, True)

If si Is Nothing Then
‘ Nothing to do, no intersect
Else
If si.Curve.Area = s.Curve.Area Then
results.Add s
Else
If si.Curve.Area = ss.Curve.Area Then
results.Add ss
Else
‘ objects partial overlap so should display error message since can’t easily handle this case, for now just skip it
End If
End If
si.Delete
End If
Next j
Next i

‘ Parse all inside curves and change colors of them
For Each s In results
s.Outline.SetProperties -1, , insideColor
s.OrderToFront
Next s

Set POutlineInsideCurves = results

End Function

Public Sub OutlineInsideCurves()

Dim saveUnit As cdrUnit
Dim saveOptimizeState As Boolean

Dim slanted As Boolean
Dim Spacing As Double

Dim insideColor As Color
Dim sr As ShapeRange

saveOptimizeState = Application.Optimization
saveUnit = ActiveDocument.Unit
Application.Optimization = True

On Error GoTo cleanState

ActiveDocument.BeginCommandGroup “Outline Inside Curves”

Set insideColor = CreateRGBColor(0, 255, 0)

Set sr = POutlineInsideCurves(ActiveSelectionRange, insideColor)

cleanState:
ActiveDocument.EndCommandGroup
ActiveDocument.Unit = saveUnit
Application.Optimization = saveOptimizeState
ActiveWindow.Refresh

 

 

 

End Sub

Actually, I’ve started writing a few extra macros, greatly inspired by the fantastic job of Alex and James [will let you find who they are :-) ]

The plan is to distribute these macros for free when we will have a full set of them, and work on doing improved/faster one in C/C++ for professional use and sell them for a fee + include them with a line of laser cutter we hope to design in the next years, most probably based on an opensource design greatly scaled up ;-:

Alexis Martial
Managing Director and Crazy Encoder, Plixo

This entry was posted in CorelDraw Macros, Laser Cutting & Engraving Services, Software and tagged , , , . Bookmark the permalink.

Leave a Reply