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, 12: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 15:54. Reason: still need info
#2
17-02-2011, 15: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, 16: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, 16: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, 16: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 16:47. Reason: added to
#6
17-02-2011, 17: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

 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 20:52 CWCN CorelDRAW/Corel DESIGNER VBA 1 17-11-2008 13:19 jemmyell CorelDRAW/Corel DESIGNER VBA 5 27-07-2005 15:25 Alex FAQ 1 24-05-2005 11:42 reanan CorelDRAW/Corel DESIGNER VBA 3 04-12-2002 15:35

All times are GMT -5. The time now is 01:10.

 OberonPlace.com - Archive - Top