Ok, I must be losing memory or something, but what is the correct way to loop through a ShapeRange that changes over time? As an example I have something like this (in pseudocode):
Tag:For Each S In SR.Shapes.All For Each T In SR.Shapes.All If S compared to T is something Then T.Delete Goto Tag End If Next T Next S
Tag:For Each S In SR.Shapes.All
For Each T In SR.Shapes.All
If S compared to T is something Then
T.Delete Goto Tag
End If
Next T
Next S
And no matter what I try:
it throws an error at some point that the shapes are no longer there. Basically what I want to do here is remove overlapping shapes in the same ShapeRange with specific parameters.
Any suggestions?
Please, try the next way:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
Sub testIterateDeleteOverlapped() Dim SR As ShapeRange, shDel As New ShapeRange, s As Shape, T As Shape Set SR = ActiveLayer.Shapes.All For Each s In SR.Shapes For Each T In SR.Shapes If SR.IndexOf(s) <> SR.IndexOf(T) Then 'to avoid testing of the same shape overlapping If s.DisplayCurve.IntersectsWith(T.DisplayCurve) Then If shDel.count > 0 Then 'if there are shapes in the shape range to be deleted If shDel.IndexOf(T) = 0 Then shDel.Add s 'it checks if the shape already exists before adding it Else shDel.Add s 'add the shape in the shape range to be deleted End If End If End If Next Next shDel.CreateSelection 'selecting only for testing End Sub
If it selects what you need, it is enough to replace `CreateSelection` with `Delete`...
So far this works incredibly well. I wasn't aware of IndexOf, but it really helps for something like this. Thanks a lot for the detailed code and comments!