I have double cut lines when I "Trim" one shape from another. Where the two objects meet each other it cuts both lines even though they are identical and in the same place. This shreds my sandblast resist stencil that i am cutting. I installed RemoveUnderlyingDups.gms and when I try to use it i get a -Microsoft Visual Basic RunTime error '424' Object Required- message. When I hit the debug button it shows me the code error. i have copied it and pasted below. Please help as I know nothing about macros or codes. I've been lucky to get this far via google searches and youtube videos. The error is occurring in line 16 (shown in RED)
Public Sub boostStart(Optional ByVal unDo As String = "") ' ================================================================================================= If unDo <> "" Then ActiveDocument.BeginCommandGroup unDo Optimization = True EventsEnabled = False ActiveDocument.SaveSettings ActiveDocument.PreserveSelection = FalseEnd Sub
Public Sub boostFinish(Optional ByVal endUndoGroup As Boolean = False) ' ================================================================================================= Dim cs As Object ActiveDocument.PreserveSelection = True ActiveDocument.RestoreSettings EventsEnabled = True Optimization = False Application.Refresh ActiveWindow.Refresh Set cs = CorelDRAW.CorelScript cs.RedrawScreen If endUndoGroup Then ActiveDocument.EndCommandGroupEnd Sub
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 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 boostStart 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.Curve.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 boostFinish If toDEL.Count = 0 Then Exit Sub toDEL.CreateSelection If MsgBox("Confirm delete " + CStr(toDEL.Count) + " objects", vbOKCancel) = vbOK Then _ toDEL.DeleteEnd Sub
Public Sub NodeClean2() Dim s As Shape, s2 As Shape Dim n As Node, n2 As Node, o As Node, o2 As Node, IsFirstNode As Boolean Dim origShapes As New ShapeRange, nearShapes As ShapeRange Dim combineShapes As New ShapeRange, delShape As New ShapeRange, Alone% Set origShapes = ActivePage.FindShapes(, cdrCurveShape) boostStart "Node cleaning" On Error GoTo CloseUndoTransaction Do While origShapes.Count > 1 Set s = origShapes(1) With s.Curve.SubPaths.Item(1): Set n = .StartNode: Set o = .EndNode: End With Set nearShapes = ActivePage.SelectShapesAtPoint(n.PositionX, n.PositionY, True).Shapes.All nearShapes.AddRange ActivePage.SelectShapesAtPoint(o.PositionX, o.PositionY, True).Shapes.All Alone = (nearShapes.Count = 1) Do While nearShapes.Count > 0 Set s2 = nearShapes(1) If s2.Type = cdrCurveShape And s2.StaticID <> s.StaticID Then With s2.Curve.SubPaths.Item(1): Set n2 = .StartNode: Set o2 = .EndNode: End With If n.GetDistanceFrom(o2) = 0 Or o.GetDistanceFrom(o2) = 0 Then IsFirstNode = (n.GetDistanceFrom(o2) = 0) combineShapes.Add s: combineShapes.Add s2 delShape.RemoveAll: delShape.Add s2 origShapes.RemoveRange delShape Set s = combineShapes.Combine: combineShapes.RemoveAll combineShapes.RemoveAll With s.Curve.SubPaths If .Count = 2 Then _ If IsFirstNode Then .Item(2).EndNode.JoinWith .Item(1).StartNode _ Else .Item(2).EndNode.JoinWith .Item(1).EndNode End With If s.Curve.Nodes.First.GetDistanceFrom(s.Curve.Nodes.Last) = 0 Then _ s.Curve.Nodes.First.JoinWith s.Curve.Nodes.Last origShapes.Add s Exit Do End If End If nearShapes.Remove 1 Loop origShapes.Remove 1 Loop CloseUndoTransaction: boostFinish True If Err.Number Then MsgBox "Error: " + Err.DescriptionEnd Sub