Could I get some help with this DetectIntersects macro?

I need to be able to detect whether any shape selected intersects with any other shape in the selection. Regardless of whether the shape is a curve or text. Comes in handy just before cutting vinyl. Often times characters "overlap" each other so a warning needs to be thrown. In the image I have purposely moved an "f", within the artistic text, to intersect with another character. The macro errors at the line noted. Interesting to note is that sometimes when the text is converted to curves it becomes a group of shapes. Especially if a lot of text.

Sub DetectIntersects()
Dim sr As ShapeRange
Dim s1 As Shape, s2 As Shape
Dim bFound As Boolean
Optimization = True
bFound = False

Set sr = ActiveSelectionRange

If sr.Count <> 1 Then MsgBox ("Select shapes first"): GoTo exit1

For Each s1 In sr.Shapes
If bFound Then Exit For
For Each s2 In sr.Shapes
If Not s1 Is s2 Then
If s1.DisplayCurve.IntersectsWith(s2.DisplayCurve) Then 'ERROR HERE
bFound = True

Exit For
End If
End If
Next s2
Next s1

If bFound Then MsgBox "CAUTION! Something Intersects!!!", _
vbCritical, "Check For Intersecting lines"

If Not bFound Then MsgBox "Good", _
vbDefaultButton1, "Check For Intersecting lines"
Optimization = False


End Sub

Parents Reply
  • Below is the correct one. Which I thought came from you anyway. lol.

    That code does not look familiar to me at all.

    I played around with this a little bit last week, and I agree that creating temporary duplicate shapes is probably the way to go with this.

    For some stuff, you can get away with creating virtual shapes instead of real duplicates, but I don't know if ConvertToCurves can be used with virtual shapes.