Search code examples
vbacoreldraw

CorelDraw: Trouble with Intersect command

I use VBA to construct a complex drawing with CorelDraw (version 17.6). As part of the drawing, I have a rectangle which is intersected by several curves, which I have formatted individually. I use the Intersect command to remove those parts of the curves which lie outside the rectangle. But after the intersection the line properties of the curves have been altered to be those of the rectangle!

The subroutine below demonstrates this claim. Run it as is and it creates the rectangle and curves. Comment out the first “End” statement to se the result of the intersections. And comment out the second one to see the renewed assignment of the curves’ properties.

Of course I could have avoided assigning properties in the first place. Now my questions:

  • Why has intersection the side effect of inheriting curve properties (color, thickness, outline) from the bounding rectangle?

  • Have I overlooked something which could avoid this, is it a bug?

  • Could the intersection be performed smarter using an array of shapes or a shape range?

VBA code:

Note: The sub starts with deleting any existing shapes!

Sub TestIntersect()
    Dim shp As Shape, shpRect As Shape, shpCurve1 As Shape, shpCurve2 As Shape, shpCurve3 As Shape
    
    For Each shp In ActivePage.Shapes
        shp.Delete
    Next shp
    ActiveDocument.Unit = cdrMillimeter
    Set shpRect = ActiveLayer.CreateRectangle(20, 80, 70, 50)
    shpRect.Outline.SetPropertiesEx 0.2, OutlineStyles(0), CreateRGBColor(0, 255, 255)
    
    Set shpCurve1 = ActiveLayer.CreateEllipse2(23, 75, 15, 15, -90, 160)
    ' CorelDraw measures angles clockwise!
    shpCurve1.Outline.SetPropertiesEx 0.5, OutlineStyles(0), CreateRGBColor(255, 0, 0)
    
    Set shpCurve2 = ActiveLayer.CreateLineSegment(55, 93, 30, 45)
    shpCurve2.Outline.SetPropertiesEx 0.7, OutlineStyles(4), CreateRGBColor(0, 255, 0)
    
    Set shpCurve3 = ActiveLayer.CreateLineSegment(62, 88, 58, 30)
    shpCurve3.Outline.SetPropertiesEx 1.2, OutlineStyles(7), CreateRGBColor(0, 0, 255)
    End
    
    Set shpCurve1 = shpCurve1.Intersect(shpRect, False, True)
    Set shpCurve2 = shpCurve2.Intersect(shpRect, False, True)
    Set shpCurve3 = shpCurve3.Intersect(shpRect, False, True)
    End
    
    shpCurve1.Outline.SetPropertiesEx 0.5, OutlineStyles(0), CreateRGBColor(255, 0, 0)
    shpCurve2.Outline.SetPropertiesEx 0.7, OutlineStyles(4), CreateRGBColor(0, 255, 0)
    shpCurve3.Outline.SetPropertiesEx 1.2, OutlineStyles(7), CreateRGBColor(0, 0, 255)
End Sub
Solution

  • I will try answering the next part of your question (the questions themselves):

    1. Why has intersection the side effect of inheriting curve properties (color, thickness, outline) from the bounding rectangle?

    2. Have I overlooked something which could avoid this, is it a bug?

    3. Could the intersection be performed smarter using an array of shapes or a shape range?

    A. It is not a bug, it is good to know that the intersection returned shape takes properties of the shape used to Intersect. I mean, you should change

     Set shpCurve1 = shpCurve1.Intersect(shpRect, False, True)

    in

    Set shpCurve1 = shpRect.Intersect(shpCurve1, True, False)

    B. Please, see A. issue, which answers this question, too...

    C. I do not know it will be "smarter", but you can use a preliminary ShapeRange which to be grouped (a ShapeRange cannot be used for intersection, but transforming it in a grouped) Shape:

    'your existing code...
Dim shR As New ShapeRange

Set shpCurve1 = ActiveLayer.CreateEllipse2(23, 75, 15, 15, -90, 160)
    ' CorelDraw measures angles clockwise!
    shpCurve1.Outline.SetPropertiesEx 0.5, OutlineStyles(0), CreateRGBColor(255, 0, 0)
    shR.Add shpCurve1
    
    Set shpCurve2 = ActiveLayer.CreateLineSegment(55, 93, 30, 45)
    shpCurve2.Outline.SetPropertiesEx 0.7, OutlineStyles(4), CreateRGBColor(0, 255, 0)
    shR.Add shpCurve2
    
    Set shpCurve3 = ActiveLayer.CreateLineSegment(62, 88, 58, 30)
    shpCurve3.Outline.SetPropertiesEx 1.2, OutlineStyles(7), CreateRGBColor(0, 0, 255)
    shR.Add shpCurve3
    Dim shG As Shape
    Set shG = shR.Group
    
    Set shpCurve1 = shpRect.Intersect(shG, True, False)