How to detect holes in combined curve objects?

Hi all, This is very old post, however I still need help with this. please see the post below. thank you



Hi all, I am trying to figure out a way to identify all of the curves that are "holes" in combined shapes. An example would be if i had a 6 inch square and a 3 inch square center with eachother, and then I combined them, the 3 inch square would be a "hole". However if i added a 1 inch square to the center of that shape and combined it, it would not be a hole but rather solid and the 3 inch square would now become the hole.
To further complicate things the combined curves may or may not be "on top of" eachother. Like the lowercase letter "i" is one shape that is made up of two combined curves and neither of them are holes".

I am starting with thousands of shapes/curve objects that could have any number of curves combined together and these curves may or may not overlap or be inside of the other curves.

I have tried:
Identifying the winding direction of the path. that didn't work since they all had the same winding.

I tried:
measuring the total dimensions of the "parent" shape. Then breaking it apart and measuring the dimensions of the broken apart shapes looking to see if any one of the broken apart shapes were the same size as the parent shape's dimensions. Then assuming that if there were shapes that were smaller then they would have been holes. This didn't work because I could create shape configureations that would break that logic. Such as the letter "U" with a small object resting inside the "U" shape and combined with the letter.

I tried:
getting the x & y cords. of each curve to see if they fell within the "parent" shape assuming that if they did then they were holes. however the "U" example above still breaks the logic.

So.... I'm not sure what to do next.

Any help would be appreciated.


Thanks,
Mitsu1

this is an old post but I still need help with this. If anyone can help me with how to detect a shapes "winding" that would be most appreciated.
thanks
Mitsu1

[runflacruiser]

Hi.
You can get it from the Fillmode property of a curve shape.
It's not read only so you can get it, and set it.

Sub ToggleWindingRuleOfSelectedObjects()
    Dim s As Shape
    For Each s In ActiveSelection.Shapes
        If s.Type = cdrCurveShape Then
            If s.FillMode = cdrFillWinding Then
                s.FillMode = cdrFillAlternate
            Else
                s.FillMode = cdrFillWinding
            End If
        End If
    Next s

-John

Thanks a ton John. I will try this out. I appreciate the quick response.

-Mitsu1

Hi again runflacruiser,

I tried to break down the code you had by rem-ing some code and working through it.. i found that when I selected multiple shapes that had very specifically different "node" winding directions, your original code seems to think that all the shapes are cdrFillAlternate....

'Sub ToggleWindingRuleOfSelectedObjects()
'Dim s As Shape
'For Each s In ActiveSelection.Shapes
'If s.Type = cdrCurveShape Then
'If s.FillMode = cdrFillWinding Then
'MsgBox ("This curve's fill mode is cdrFillWinding")

'Else
'MsgBox ("This curve's fill mode is cdrFillAlternate")

'End If
'End If
'Next s
'End Sub

by the way how do you put code in the "code" box on this forum?

[runflacruiser]

Hi.
I took a look at your original post. It seems it could be tough.
How about finding out how many shapes are stacked on one another.
Check out this code. Use on a combined shape and it will break apart and color it based on staking order. You might be able to get the shapes that have an odd number of shapes beneath them and consider them the donut holes.

PS. Use the Code BB button to post code. Third over from the right "#"

-John

Option Explicit

Sub smartBreakApart()

Dim s As Shape, sr As ShapeRange, shs As Shape
Dim sr2 As New ShapeRange, sr3 As ShapeRange
Dim x As Double, y As Double
Dim nodecount As Long, tempDis As Double

   On Error GoTo smartBreakApart_Error

If ActiveSelection.Shapes.count = 0 Then Exit Sub

Optimization = True
EventsEnabled = False
ActiveDocument.BeginCommandGroup "smart break"

ActiveSelection.UngroupAll
Set sr2 = ActiveSelection.BreakApartEx
Set sr = OrderBySize(sr2)

tempDis = 0.005

For Each s In sr
    s.OrderToFront
    s.Fill.ApplyUniformFill CreateRGBColor(64, 32, 32)
    nodecount = 1
    s.Curve.Nodes(nodecount).GetPosition x, y
    
If 1 = 2 Then
1001:
    If nodecount <= s.Curve.Nodes.count Then
        s.Curve.Nodes(nodecount).GetPosition x, y
    Else
        GoTo 1002:
    End If
End If
    
    If s.IsOnShape(x + tempDis, y) = cdrInsideShape And s.IsOnShape(x + tempDis, y) <> cdrOnMarginOfShape Then
        x = x + tempDis
        
    ElseIf s.IsOnShape(x - tempDis, y) = cdrInsideShape And s.IsOnShape(x - tempDis, y) <> cdrOnMarginOfShape Then
        x = x - tempDis
        
    ElseIf s.IsOnShape(x, y + tempDis) = cdrInsideShape And s.IsOnShape(x, y + tempDis) <> cdrOnMarginOfShape Then
        y = y + tempDis
        
    ElseIf s.IsOnShape(x, y - tempDis) = cdrInsideShape And s.IsOnShape(x, y - tempDis) <> cdrOnMarginOfShape Then
        y = y - tempDis
        
    ElseIf s.IsOnShape(x - tempDis, y - tempDis) = cdrInsideShape And s.IsOnShape(x - tempDis, y - tempDis) <> cdrOnMarginOfShape Then
        y = y - tempDis: x = x - tempDis

    ElseIf s.IsOnShape(x + tempDis, y + tempDis) = cdrInsideShape And s.IsOnShape(x + tempDis, y + tempDis) <> cdrOnMarginOfShape Then
        y = y + tempDis: x = x + tempDis
        
    ElseIf s.IsOnShape(x - tempDis, y + tempDis) = cdrInsideShape And s.IsOnShape(x - tempDis, y + tempDis) <> cdrInsideShape Then
        y = y + tempDis: x = x - tempDis
        
    ElseIf s.IsOnShape(x + tempDis, y - tempDis) = cdrInsideShape And s.IsOnShape(x + tempDis, y - tempDis) <> cdrOnMarginOfShape Then
        y = y - tempDis:  x = x + tempDis
        
    Else
        nodecount = nodecount + 1
        's.Fill.ApplyUniformFill CreateRGBColor(255, 0, 0) 'RED - testing
        GoTo 1001:
    End If
1002:
    Set shs = ActivePage.SelectShapesAtPoint(x, y, False, tempDis / 2) 'notice!!! tempdis /2
    If Not IsOdd(shs.Shapes.count) Then s.Fill.ApplyUniformFill CreateRGBColor(255, 255, 121)
    sr2.Add s
Next s

ActiveDocument.EndCommandGroup
Optimization = False
EventsEnabled = True
ActiveWindow.Refresh

   On Error GoTo 0
   Exit Sub

smartBreakApart_Error:
    ActiveDocument.EndCommandGroup
    Optimization = False
    EventsEnabled = True
    ActiveWindow.Refresh
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure smartBreakApart of Module newSmartBreakApart"
    
End Sub

Private Function IsOdd(i As Long) As Boolean
    IsOdd = (i Mod 2) <> 0
End Function

Private Function OrderBySize(sr As ShapeRange) As ShapeRange
    Dim srSorted As New ShapeRange
    Dim s As Shape, i As Integer
    Dim t As Variant, j As Integer, y As Integer
    Dim iUpper As Integer, Condition1 As Boolean
    ReDim ShapesAndSizes(sr.count - 1, 1) As Double 'Create an Array to hold area and staticID
    
    'Add shape data to array
    For i = 1 To sr.count
        ShapesAndSizes(i - 1, 0) = Round(sr(i).SizeWidth * sr(i).SizeHeight, 3) 'Area of the shape
        ShapesAndSizes(i - 1, 1) = sr(i).StaticID 'Static ID of current shape
    Next i
    
    'A very simple sort
    For i = LBound(ShapesAndSizes, 1) To UBound(ShapesAndSizes, 1) - 1
        For j = LBound(ShapesAndSizes, 1) To UBound(ShapesAndSizes, 1) - 1
            Condition1 = ShapesAndSizes(j, 0) <= ShapesAndSizes(j + 1, 0)
            If Condition1 Then
                For y = LBound(ShapesAndSizes, 2) To UBound(ShapesAndSizes, 2)
                    t = ShapesAndSizes(j, y)
                    ShapesAndSizes(j, y) = ShapesAndSizes(j + 1, y)
                    ShapesAndSizes(j + 1, y) = t
                Next y
            End If
        Next
    Next
    
    'Create a ShapeRange from the sorted array
    For i = 0 To sr.count - 1
        srSorted.Add ActivePage.FindShape(StaticID:=ShapesAndSizes(i, 1))
    Next i

    Set OrderBySize = srSorted 'Return the new sorted shaperange
End Function

-John

[jemmyell]

Hi,

Maybe you could tell us what it is you are trying to achieve with this?

I have code in my CAD / CAM libraries that detects these relationships currently. This sort of thing is not that hard in C++ but VBA lacks the data structures to sort efficiently and maintain linked lists.

-James Leonard

Hi Jemmyell,

I wanted to detect "holes" in objects. I know that a hole has a different winding than the shape that contains the hole, so I figured that that would be the best way to detect them... However, Corel doesn't do that well. In this thread I learned that you can detect "fillMode"... cool but it was unpredictable....

I would still love any help at detecting holes in complex shapes... this would be useful for a multitude of reasons.....

However, WHY i needed to detect the holes in the first place is to get rid of them.... which I happily accomplished by breaking the shape apart and then welding all of its pieces together which eliminated the holes in every complex shape that I threw at it....

Thanks for everyone's help
Mitsu1

[runflacruiser]

Hi.
See attached video.
-John

[Plixo]

I faced the same problem of finding which shapes are inside since I use CorelDraw to control my laser cutter, see our Laser Cutting and Engraving Services in case you visit Singapore, you should make a stop at our workshop ;-)

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.

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.

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 :-)
The plan is to distribute these macros for free when I will have a full set, 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 I 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
Plixo: Where Innovation, Art & Workmanship Join Hands