I have a drawing with 30.000 shapes. and most of them has another circle right in the middle of other circle. (attached image is only a small part of them).
I am not a VBA programmer but I wrote something but nothing is combined:
Sub combineCircleInCircle() Dim kreis As Shape Dim s As Shape Dim combined As Shape Dim xKreis As Double Dim yKreis As Double Dim xs As Double Dim ys As Double For Each kreis In ActivePage.Shapes kreis.GetPosition xKreis, yKreis For Each s In ActivePage.Shapes s.GetPosition xs, ys If xs = xKreis And ys = yKreis Then ActiveDocument.CreateSelection s, kreis Set combined = ActiveSelection.Combine End If Next NextEnd Sub
After combining, some shapes may disappear. And you need to compare the coordinates of the centers, and GetPosition can return the coordinates, for example, of the lower left corner
My problem is: Nothing combined. Absolutely nothing. No one circle dissapears.
I alignet circles top-left, top-right, bottom-left, bottom right and centered. Script is not combined any of them.
What do you like to combine? The two circles? It looks you make selection of the same shape...
Try using:
1
Debug.Print ActiveSelection.Shapes.Count
just before
Set combined = ActiveSelection.Combine
and see how many shapes are in selection...
I would suggest using of:
1 2 3 4 5
If ActiveLayer.Shapes.All.IndexOf(kreis) <> _ ActiveLayer.Shapes.All.IndexOf(s) Then ActiveDocument.CreateSelection s, kreis Set combined = ActiveSelection.Combine End If
It works now, thank you. But I wrote also:
ActiveDocument.CreateSelection s, kreis
Why is in my programm only one object selected?
Of course...
was inside of the condition.
Corel couldn't know to skip the same shape found in the second iteration. Now, if it works, it will increase the code speed if you use
Exit For
after
It tooks still long time with my way.
Is there a way more efficient? I would like to "combine object with same center points"
Try using
Application.Optimization = True
before starting the iterations, followed by
Application.Optimization = False
after...