OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 24-07-2009, 12:55
mitsu1
Guest
 
Posts: n/a
Question 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
Reply With Quote
  #2  
Old 17-02-2011, 15:57
mitsu1
Guest
 
Posts: n/a
Default 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
Reply With Quote
  #3  
Old 17-02-2011, 16:21
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

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
Reply With Quote
  #4  
Old 17-02-2011, 16:26
mitsu1
Guest
 
Posts: n/a
Default

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

-Mitsu1
Reply With Quote
  #5  
Old 17-02-2011, 16:46
mitsu1
Guest
 
Posts: n/a
Default

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
Reply With Quote
  #6  
Old 17-02-2011, 17:30
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

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
-John
Reply With Quote
Reply


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

Advanced Search
Display Modes

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 Jump

Similar Threads
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


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


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2023, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com