OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Corel User Forums > CorelDRAW > Macros/Add-ons

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 09-06-2003, 08:50
Gerard Hermans
Guest
 
Posts: n/a
Default New macro to clip curves w.r.t. a border

Hello all,

I wrote a VBA macro that clips a given curve w.r.t. a closed curve of some border.
I needed such a macro because I wanted my (calculated) geometry-plots inside a given rectangle.
So the parts that stick out should be erased.

I do not have a web-site, therefore copied the code in here to share the macro with you and of course to receive helpfull feedback.

To test/use this macro create a closed curve (a rectangle should be converted to a curve) with only 1 subpath, and another arbitrary curve.
Call the macro in VBA code with variables that refer to these shapes (the macro could be changed to include a pick-tool to select these shapes with a mouse-click): 8)

Code:
Private Sub Clip(ByVal Border As Shape, ByRef ShapeToClip As Shape)

Dim csp As CrossPoints, cp As CrossPoint
Dim sp As SubPath
Dim n As Node
Dim s As Shape
Dim srIn As ShapeRange
Dim i As Integer, j As Integer
Dim crv As Curve
Dim sgm As Segment
Dim x As Double, y As Double
Dim NrDeleted As Integer
Dim NrTotal As Integer
Dim Repeat As Boolean
    
    ' Validation
    If Border.Curve.Subpaths.Count > 1 Or Border.Curve.Closed = False Then _
                    Err.Raise vbObjectError + 513, "Clip", _
                    "This macro supports a closed border with 1 subpath"
    If ShapeToClip.Type <> cdrCurveShape Then _
                    Err.Raise vbObjectError + 514, "Clip", _
                                    "This macro supports CurveShapes"
    Set crv = ShapeToClip.Curve
    Repeat = False
    
' Repetition is a workaround, see below
clip_repetition:

    For j = crv.Subpaths.Count To 1 Step -1
        
        ' Add nodes on the intersections with the border
        Set csp = crv.Subpaths(j).GetIntersections(Border.Curve.Subpaths(1), cdrRelativeSegmentOffset)
        For Each cp In csp
            crv.Subpaths(j).AddNodeAt cp.Offset, cdrRelativeSegmentOffset
        Next cp
        
        ' Clip all nodes outside the border
        NrDeleted = 0
        NrTotal = crv.Subpaths(j).Nodes.Count
        For i = NrTotal To 1 Step -1
            Set n = crv.Subpaths(j).Nodes(i)
            Select Case Border.Curve.IsOnCurve(n.PositionX, n.PositionY)
                Case cdrInsideShape, cdrOnMarginOfShape
                Case cdrOutsideShape
                    n.Delete
                    NrDeleted = NrDeleted + 1
                    ' Deletion of second last node deletes last node as well
                    If (NrTotal - NrDeleted) < 2 Then Exit For
            End Select
        Next i
    Next j
    
    ' Break apart segments that do not have a node outside the border
    ' First intersection with the border
    For j = crv.Subpaths.Count To 1 Step -1
        For i = crv.Subpaths(j).Segments.Count To 1 Step -1
            Set sgm = crv.Subpaths(j).Segments(i)
            Call sgm.GetPointPositionAt(x, y, 0.5, cdrRelativeSegmentOffset)
            Select Case Border.Curve.IsOnCurve(x, y)
                Case cdrInsideShape, cdrOnMarginOfShape
                Case cdrOutsideShape
                    sgm.BreakApartAt 0, cdrRelativeSegmentOffset
            End Select
        Next i
    Next j
    ' Second intersection with the border
    For j = crv.Subpaths.Count To 1 Step -1
        For i = crv.Subpaths(j).Segments.Count To 1 Step -1
            Set sgm = crv.Subpaths(j).Segments(i)
            Call sgm.GetPointPositionAt(x, y, 0.5, cdrRelativeSegmentOffset)
            Select Case Border.Curve.IsOnCurve(x, y)
                Case cdrInsideShape, cdrOnMarginOfShape
                Case cdrOutsideShape
                    sgm.BreakApartAt 1, cdrRelativeSegmentOffset
            End Select
        Next i
    Next j
    
    ' Break all subpaths of the curve apart
    Set srIn = ShapeToClip.BreakApartEx
    ' Delete the subpaths outside of the border
    For Each s In srIn
        Call s.Curve.Subpaths(1).GetPointPositionAt(x, y, 0.5, cdrRelativeSegmentOffset)
        Select Case Border.Curve.IsOnCurve(x, y)
            Case cdrInsideShape, cdrOnMarginOfShape
            Case cdrOutsideShape
                s.Delete
        End Select
    Next s
    ' Combine the remaining subpaths again
    Set ShapeToClip = srIn.Combine
    
    ' Workaround:
    ' Sometimes the clip must be repeated to complete everything (..?)
    Set crv = ShapeToClip.Curve
    Repeat = Not Repeat
    If Repeat Then GoTo clip_repetition

    ' Release objects
    Set s = Nothing
    Set srIn = Nothing
    Set crv = Nothing
    Set sp = Nothing
    Set n = Nothing
    Set cp = Nothing
    Set csp = Nothing
    Set sgm = Nothing
End Sub
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
Convert barcode to curves pp21 New product ideas 1 10-03-2004 23:56


All times are GMT -5. The time now is 17:42.


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