OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Oberon Products > New product ideas

Thread Tools Search this Thread Display Modes
Old 18-10-2008, 01:41
Posts: n/a
Default 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?

Reply With Quote
Old 18-10-2008, 16:47
shelbym's Avatar
shelbym shelbym is offline
Senior Member
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,778
Blog Entries: 10
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default A little code...

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
    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
            Set seg = seg.SubPath.LastSegment
        End If
        CheckStart bStarted
    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
End Sub
Happy coding,

Reply With Quote

Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Global Macro delete Michael Cervantes CorelDRAW/Corel DESIGNER VBA 17 16-11-2010 09:11
Delete small objects macro Jeff Harrison New product ideas 3 19-05-2007 13:19
Delete Segment Sablesword Other Oberon Commercial Products 0 07-01-2007 20:28
Macro to Delete Leading Zeros in selected shapes (dimensions) Jon Lorber CorelDRAW/Corel DESIGNER VBA 1 18-05-2006 13:25
Delete Segment Enhanced Hernán New product ideas 1 08-12-2003 16:04

All times are GMT -5. The time now is 04:53.

Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com