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
In reply to Pioneer Rock:
OK, I think I understand the nature of the problem better. When you trim one closed curve using another closed curve, the shared edges are "doubled up" for your cutting.
You will get different results with the Trim operation if the "target" object is an open curve.
Before, with two closed shapes:
Convert the rectangle to curves, then break it so that it becomes an open curve. In this case, I've actually shown a visible gap, but that's not necessary; it's sufficient just to Break Apart a node to open the curve:
Trim the open curve using the closed curve:
Move the closed curve out of the way to see the result of the Trim:
Is that the sort of result you are looking for?
Pioneer RockAfter reading more carefully what you wrote and breaking the curve it works great!!!!!!! Thank you! Thank you! Are you aware of any Macros that would do this automatically?
You're welcome. I've never tried to accomplish this particular sort of task, so it was educational for me.
I don't know exactly where one might go with automation on this.
It is fairly quick (a few seconds) to add a node (if necessary) then Break Apart to open the curve.
If one uses the Shaping docker, it is already easy to select multiple shapes to use as "cutters", press the "Trim" button, and then select the "target" to be trimmed.
In reply to Eskimo:
© Corel Corporation. The content herein is in the form of a personal web log ("Blog") or forum posting. As such, the views expressed in this site are those of the participants and do not necessarily reflect the views of Corel Corporation, or its affiliates and their respective officers, directors, employees and agents. Terms and Conditions / User Guidelines.