![]() |
|
#1
|
|||
|
|||
![]()
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
|
|||
|
|||
![]()
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
|
||||
|
||||
![]()
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 |
#4
|
|||
|
|||
![]()
Thanks a ton John. I will try this out. I appreciate the quick response.
-Mitsu1 |
#5
|
|||
|
|||
![]()
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
|
||||
|
||||
![]()
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) 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 |
![]() |
Currently Active Users Viewing This Thread: 1 (0 members and 1 guests) | |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
How to detect textbox's language or charset? | litthe | CorelDRAW/Corel DESIGNER VBA | 1 | 24-03-2009 20:52 |
Fitting objects to curve | CWCN | CorelDRAW/Corel DESIGNER VBA | 1 | 17-11-2008 13:19 |
cannot close combined shape | jemmyell | CorelDRAW/Corel DESIGNER VBA | 5 | 27-07-2005 15:25 |
Arrange objects along a curve | Alex | FAQ | 1 | 24-05-2005 11:42 |
Detect if VBA is installed (an answer and a question) | reanan | CorelDRAW/Corel DESIGNER VBA | 3 | 04-12-2002 15:35 |