There is a function in the api called RemoveOverlaps, which seeks for overlaps in one curve. Is there a way to use this function over multiple curves from multiple shapes?
In short i try to remove double lines in my drawing soo my lasercutter does not cut that line twice.
Have you tried Shelbys Super Stitch?
I've downloaded and will report shortly as to how it works.
Although no "version compatibility" listed on the Macromonster site, it does not work with recent versions of CorelDRAW. Even worse, running the macro leaves CorelDRAW in a strange state requiring restart.
In order to solve the 'strange state' without restart you must use a simple macro to, let's say, unlock the interface:
Application.EventsEnabled = True
Application.Optimization = False
If Documents.Count > 0 Then
ActiveDocument.PreserveSelection = True
Thanks for the tip. I've stored it and will use it the next time that "strange state" shows up!
superstitch is based on this macro: tweak as you like.
Sub removeUnderlyingDups() Dim s As Shape, sr As New ShapeRange, props() As Double Dim toDel As New ShapeRange, stat As AppStatus, Jitter As Double, cnt&, idx&, _ x As Double, y As Double, w As Double, h As Double, n&, match%, i& Jitter = 0.0001 On Error Resume Next If ActiveSelectionRange.Count = 0 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 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 If w < Jitter And h < Jitter Then toDel.Add s: cnt = cnt + 1 Else For i = 1 To cnt If stat.Aborted Then Exit For If Abs(props(i, 1) - x) < Jitter Then _ If Abs(props(i, 2) - y) < Jitter Then _ If Abs(props(i, 3) - w) < Jitter Then _ If Abs(props(i, 4) - h) < Jitter 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 End If Next s If toDel.Count = 0 Then Exit Sub toDel.CreateSelection If MsgBox("Confirm delete " + CStr(toDel.Count) + " objects", vbOKCancel) = vbOK Then _ toDel.Delete Application.Status.EndProgressEnd Sub