Delete Segment macro addendum request

Hi. Just discovered your website and signed on to the forum. Have used Corel for years not too seriously, I now operate a laser that "prints" thru Corel x3. I want to create "tabs" at a pre defined length, say .04 in or approx. 1mm. for keeping small parts connected to the background after they are laser cut (vector, not raster). My thought is to add 2 nodes that .04" distance apart with the mouse click before the rest of the macro does its thing. Is this possible?

Thanks

[shelbym]

Sure you should be able to modify it. I have tested this version under X4, should work for X3, but WILL NOT WORK for any version prier to X3.

I renamed to macro AddTab, so you can still use Delete Segment.

One other note, the gap it created to the left of were you click, I am lazy and did not want to do the math to make it centered. Sorry!

Option Explicit

Private Sub CheckStart(ByRef bStarted As Boolean)
    If Not bStarted Then
        bStarted = True
        ActiveDocument.BeginCommandGroup "Add Tab"
    End If
End Sub

Private Sub CheckEnd(ByRef bStarted As Boolean)
    If bStarted Then
        bStarted = False
        ActiveDocument.EndCommandGroup
    End If
End Sub

Private Sub DoAddTab(x As Double, y As Double, s As Shape, ByRef bStarted As Boolean)
    Dim offs As Double, seg As Segment, n As Node

    Set seg = Nothing
    Set seg = s.Curve.FindSegmentAtPoint(x, y, offs)
    
    If Not seg Is Nothing Then
        If s.Outline.Type = cdrNoOutline Then
            CheckStart bStarted
            s.Outline.Type = cdrOutline
        End If
        CheckStart bStarted
        Set n = seg.AddNodeAt(offs)
        Set n = seg.AddNodeAt(seg.Length - 0.04, cdrAbsoluteSegmentOffset) 'Change this number for larger/smaller tab size
        Set seg = seg.Next
        If Not seg.EndNode.IsEnding Then
            CheckStart bStarted
            seg.EndNode.BreakApart
            Set seg = seg.SubPath.LastSegment
        End If
        CheckStart bStarted
        seg.EndNode.Delete
    End If
End Sub

Sub AddTab()
    Dim x As Double, y As Double, shift As Long
    Dim s As Shape, ss As Shape
    Dim bStarted As Boolean
          
    If Documents.Count = 0 Then
        MsgBox "No document open.", vbCritical
        Exit Sub
    End If
    
    While ActiveDocument.GetUserClick(x, y, shift, 1000, False, cdrCursorPickOvertarget) = 0
        bStarted = False
        Set s = ActiveDocument.ActivePage.SelectShapesAtPoint(x, y, False)
        For Each ss In s.Shapes
            If ss.Type = cdrCurveShape Then
                If ss.IsOnShape(x, y) = cdrOnMarginOfShape Then DoAddTab x, y, ss, bStarted
            End If
        Next ss
        CheckEnd bStarted
    Wend
End Sub

Happy coding,

-Shelby