#1




Checking for shape intersection
I've tried somthing like:
Shape1.GetPosition x,y Shape2.IsOnShape (x,y) but it's too slow. Now I'm using: Set tempShape=shape1.Intersect(shape2) tempShape.Delete which looks clumsy but (Surprisingly!)is not slower then the first and is much more reliable.Can you give me any tips for improving performance?And is there any real documentation about CorelDraw12 object model ? Thank you. 
#2




VBA Help File
I find the VBA help file to be the best resource, it includes examples and is pretty easy to follow here is the page on Intersect Shape.Intersect
Code:
Shape.Intersect Function Intersect(ByVal TargetShape As Shape, [ByVal LeaveSource As Boolean = True], [ByVal LeaveTarget As Boolean = True]) As Shape Description The Intersect method creates an object which is an intersection of two shapes. TargetShape Specifies the object that intersects with the shape object [in] LeaveSource Determines whether to keep the shape object after the intersection is complete [in] Optional Default value = True LeaveTarget Determines whether to keep the target object after the intersection is complete [in] Optional Default value = True Example The following example creates a color diagram for the additive color model (RGB). Three circles are filled, each with red, green, and blue. At the intersections of the circles, the resulting color blend fills the areas: white in the middle, while cyan, magenta, and yellow fill the areas between each pair of circles. Sub Test() Dim s(0 To 2) As Shape Dim si(0 To 2) As Shape Dim sm As Shape Dim x As Double, y As Double Dim i As Long, n As Long Dim r As Long, g As Long, b As Long Dim c1 As Color, c2 As Color For i = 0 To 2 x = ActivePage.SizeWidth / 2 + 1 * Cos(i * 2.09439507) y = ActivePage.SizeHeight / 2 + 1 * Sin(i * 2.09439507) Set s(i) = ActiveLayer.CreateEllipse2(x, y, 1.5) r = 255 * (i = 0) g = 255 * (i = 1) b = 255 * (i = 2) s(i).Fill.UniformColor.RGBAssign r, g, b Next i For i = 0 To 2 n = (i + 1) Mod 3 Set si(i) = s(i).Intersect(s(n)) Set c1 = s(i).Fill.UniformColor Set c2 = s(n).Fill.UniformColor r = c1.RGBRed + c2.RGBRed g = c1.RGBGreen + c2.RGBGreen b = c1.RGBBlue + c2.RGBBlue si(i).Fill.UniformColor.RGBAssign r, g, b Next i Set sm = si(1).Intersect(si(2)) sm.Fill.UniformColor.RGBAssign 255, 255, 255 End Sub 
#3




Shape.IsOnShape
Here is the Shape.IsOnShape Example from the help file:
Code:
Sub Test() Dim s As Shape Dim x As Double, y As Double While ActiveDocument.GetUserClick(x, y, 0, 100, False, cdrCursorPickOvertarget) = 0 For Each s In ActivePage.Shapes Select Case s.IsOnShape(x, y) Case cdrOnMarginOfShape If s.Outline.Type = cdrOutline Then s.Outline.Color.RGBAssign 255, 255, 0 Exit For End If Case cdrInsideShape s.Fill.UniformColor.RGBAssign 255, 255, 0 Exit For End Select Next s Wend End Sub 
#4




Also Try SubPath.GetIntersections
You might also try SubPath.GetIntesections, example follows:
Code:
The following example displays the number of times the two selected curves intersect, and marks each intersection point with a small circle. Sub Test() Dim sr As ShapeRange Dim sp1 As SubPath, sp2 As SubPath Dim cps As CrossPoints, cp As CrossPoint Dim x As Double, y As Double, n As Long Set sr = ActiveSelectionRange If sr.Count <> 2 Then MsgBox "Please select two curves", vbCritical Exit Sub End If If sr(1).Type <> cdrCurveShape Or sr(2).Type <> cdrCurveShape Then MsgBox "One of the selected shapes is not a curve", vbCritical Exit Sub End If n = 0 For Each sp1 In sr(1).Curve.Subpaths For Each sp2 In sr(2).Curve.Subpaths Set cps = sp1.GetIntersections(sp2) For Each cp In cps ActiveLayer.CreateEllipse2 cp.PositionX, cp.PositionY, 0.05 Next cp n = n + cps.Count Next sp2 Next sp1 MsgBox n & " intersection point(s) found" End Sub 
Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)  
Thread Tools  Search this Thread 
Display Modes  


Similar Threads  
Thread  Thread Starter  Forum  Replies  Last Post 
Checking if a file exists before importing  Rick Randall  CorelDRAW/Corel DESIGNER VBA  1  01032004 11:33 