OberonPlace.com Forums > VBA How to detect holes in combined curve objects?
 Blogs Gallery FAQ Members List Social Groups Calendar Search Today's Posts Mark Forums Read

#1
24-07-2009, 11:55
 mitsu1 Guest Posts: n/a
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

Last edited by mitsu1; 17-02-2011 at 14:54. Reason: still need info
#2
17-02-2011, 14:57
 mitsu1 Guest Posts: n/a
oldy but a goodie

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
#3
17-02-2011, 15:21
 runflacruiser Senior Member Join Date: Jun 2009 Location: Pigeon Forge, TN USA Posts: 811

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.

Code:
```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
#4
17-02-2011, 15:26
 mitsu1 Guest Posts: n/a

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

-Mitsu1
#5
17-02-2011, 15:46
 mitsu1 Guest Posts: n/a

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?

Last edited by mitsu1; 17-02-2011 at 15:47. Reason: added to
#6
17-02-2011, 16:30
 runflacruiser Senior Member Join Date: Jun 2009 Location: Pigeon Forge, TN USA Posts: 811

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

Code:
```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)
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

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
Next i

Set OrderBySize = srSorted 'Return the new sorted shaperange
End Function```
-John
#7
18-02-2011, 10:37
 jemmyell Senior Member Join Date: Jan 2005 Location: Orange County, California, USA, Earth, Solar System, Milky Way Galaxy Posts: 157

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
__________________
-James Leonard
#8
22-02-2011, 14:23
 mitsu1 Guest Posts: n/a

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
#9
22-02-2011, 14:42
 runflacruiser Senior Member Join Date: Jun 2009 Location: Pigeon Forge, TN USA Posts: 811

Hi.
See attached video.
-John
Attached Files
 getholes.zip (195.2 KB, 586 views)
#10
06-10-2011, 13:37
 Plixo Junior Member Join Date: Oct 2011 Location: Singapore Posts: 19
Code to detect "holes" i.e. inside shapes and change their color accordingly

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.

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
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
Else
If si.Curve.Area = ss.Curve.Area Then
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

 Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)

 Posting Rules You may not post new threads You may not post replies You may not post attachments You may not edit your posts BB code is On Smilies are On [IMG] code is On HTML code is Off Forum Rules
 Forum Jump User Control Panel Private Messages Subscriptions Who's Online Search Forums Forums Home OberonPlace Discussion     Site News     Web site suggestions     Image Gallery     Testing Oberon Products     CurveWorks     SecuriDesign     Calendar Wizard     Oberon Function Plotter     Jigsaw Puzzle Creator     Other Oberon Commercial Products     New product ideas Corel User Forums     CorelDRAW         General         Tutorials         FAQ         Feature requests/wishlist         Macros/Add-ons         Artwork Showcase     Corel DESIGNER         General         Tutorials         FAQ         Feature requests/wishlist         Macros/Add-ons         Artwork Showcase     Corel PHOTO-PAINT         General         Tutorials         FAQ         Feature requests/wishlist         Macros/Add-ons         Artwork Showcase     General         About Corel         Off-Topic Developer Forums     OberonPlace Development Portal     VBA         CorelDRAW/Corel DESIGNER VBA         Corel Photo-Paint VBA         Code Critique     Corel Script         CorelDRAW CS         Corel Photo-Paint CS

 Similar Threads Thread Thread Starter Forum Replies Last Post litthe CorelDRAW/Corel DESIGNER VBA 1 24-03-2009 19:52 CWCN CorelDRAW/Corel DESIGNER VBA 1 17-11-2008 12:19 jemmyell CorelDRAW/Corel DESIGNER VBA 5 27-07-2005 14:25 Alex FAQ 1 24-05-2005 10:42 reanan CorelDRAW/Corel DESIGNER VBA 3 04-12-2002 14:35

All times are GMT -5. The time now is 12:03.

 OberonPlace.com - Archive - Top