Combining objects with same Center-Point

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
End Sub

  • Here fast code (used separate check of coordinates and their rounding):

    Private Sub CombineShapes()
    Dim sr As ShapeRange, src As New ShapeRange, z&, m&
        Set sr = ActiveSelectionRange
        Optimization = True
        For z = 1 To sr.Count - 1
            For m = z + 1 To sr.Count
                If Round(sr(z).centerX, 2) = Round(sr(m).centerX, 2) Then
                    If Round(sr(z).centerY, 2) = Round(sr(m).centerY, 2) Then
                        src.Add sr(z): src.Add sr(m)
                        src.Combine:  sr.Remove m: src.RemoveAll
                        Exit For
                    End If
                End If
            Next m
        Next z
        Optimization = False: Refresh
    End Sub
Reply Children
No Data