[wOxxOm]

Originally Posted by LGD

Hey, that's great, will come in handy.... but it seems to have problems if there's a rectangle or circle on the page :-(

it is because it was intended for curves only... just a sketch of macro,
here is the version for X3 only, it uses .DisplayCurve property to count node count to make decision of identity

Sub removeUnderlyingDups()
   Dim s As Shape, sr As New ShapeRange, props() As Double
   Dim toDEL As New ShapeRange, stat As AppStatus, pr As Double, cnt&, idx&, _
       x As Double, y As Double, w As Double, h As Double, n&, match%, i&
   
   pr = 0.00001
   If ActiveShape Is Nothing Then Set sr = ActivePage.FindShapes _
      Else Set sr = ActiveSelectionRange.shapes.FindShapes
   If sr.Count = 0 Then Exit Sub
   ReDim props(1 To sr.Count, 1 To 5): cnt = 0: idx = 0
   Set stat = Application.Status
   stat.BeginProgress "Looking for curve duplicates...", True
   Optimization = True
   EventsEnabled = False
   ActiveDocument.SaveSettings
   ActiveDocument.PreserveSelection = False

   For Each s In sr
      idx = idx + 1: stat.Progress = idx / sr.Count * 100
      If stat.Aborted Then Exit For
      x = s.PositionX: y = s.PositionY: n = s.DisplayCurve.Nodes.Count
      w = s.SizeWidth: h = s.SizeHeight: match = False
      For i = 1 To cnt
         If stat.Aborted Then Exit For
         If Abs(props(i, 1) - x) < pr Then _
            If Abs(props(i, 2) - y) < pr Then _
               If Abs(props(i, 3) - w) < pr Then _
                  If Abs(props(i, 4) - h) < pr Then _
                     If props(i, 5) = n Then _
                        toDEL.Add s: match = True: Exit For
      Next i
      If Not match Then
         cnt = cnt + 1: props(cnt, 1) = x: props(cnt, 2) = y
         props(cnt, 3) = w: props(cnt, 4) = h: props(cnt, 5) = n
      End If
   Next s

   ActiveDocument.PreserveSelection = True
   ActiveDocument.RestoreSettings
   EventsEnabled = True
   Optimization = False
   Application.CorelScript.RedrawScreen

   If toDEL.Count = 0 Then Exit Sub
   toDEL.CreateSelection
   If MsgBox("Confirm delete " + CStr(toDEL.Count) + " objects", vbOKCancel) = vbOK Then _
      toDEL.Delete
End Sub