OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 03-05-2007, 08:11
Wolfgang
Guest
 
Posts: n/a
Default How to draw a line perpendicular to a curve?

Here is my problem: I would like to click to a point on the outline of a curve and vba is drawing a line (with a given length) perpendicular to the curve at this point.

Any help out there?

Wolfgang

Last edited by Wolfgang; 09-05-2007 at 09:40.
Reply With Quote
  #2  
Old 09-05-2007, 10:01
Wolfgang
Guest
 
Posts: n/a
Default

OK, no answer yet. So let me describe my problem more clearly:
1. I use Designer 12.
2. I would like to solve the following problem with VBA:
Draw a line perpendicular to a selected point on the outline of a curve.
So far I’m able to select a point:
Code:
b = ActiveDocument.GetUserClick(x, y, Shift, 60, True, cdrCursorSmallcrosshair)
test, if point is on curve (outline)
Code:
Curve.IsOnCurve
and I know, how to use
Code:
Segment.GetPerpendicularAt
but I don’t know how to get the offset for GetPerpendicularAt from the x and y values.

Please help

Wolfgang
Reply With Quote
  #3  
Old 09-05-2007, 15:39
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
 
Join Date: Mar 2005
Posts: 836
Default

Code:
Dim x#, y#, seg As Segment, offs#
Set seg = ActiveShape.Curve.FindClosestSegment(x, y, offs)
If seg Is Nothing Then Beep: Exit Sub
' here I do my work, remove next line, you don't need it :-)
Set n = seg.AddNodeAt(offs, cdrParamSegmentOffset)
Reply With Quote
  #4  
Old 10-05-2007, 04:19
Wolfgang
Guest
 
Posts: n/a
Default

thanks for the code, but what about
Code:
Set seg = ActiveShape.Curve.FindClosestSegment(x, y, offs)
FindClosestSegment(x, y, offs) is not known by VBA. Is it a function you programmed?

Wolfgang
Reply With Quote
  #5  
Old 10-05-2007, 07:35
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default

Oh, that's a new function in CorelDRAW X3. It's not available in Designer 12...

Unfortunately it's not that easily done in pre-X3 versions. I had to resort to the following trick for the Delete Segment macro (http://www.oberonplace.com/vba/drawm...lsegment.htm):

Code:
    Dim x0 As Double, y0 As Double, r As Double, n As Long, r0 As Double
    Dim sp As SubPath, seg As Segment, seg0 As Segment
    r = 1E+50
    Set seg0 = Nothing
    For Each seg In s.Curve.Segments
        For n = 0 To 49
            seg.GetPointPositionAt x:=x0, y:=y0, Offset:=n / 50, OffsetType:=cdrParamSegmentOffset
            x0 = x0 - x
            y0 = y0 - y
            r0 = x0 * x0 + y0 * y0
            If r0 < r Then
                r = r0
                Set seg0 = seg
            End If
        Next n
    Next seg
...
Here x and y are the coordinates of the point where the user clicks. seg0 and x0,y0 would be the segment and offset of the point on that segment from the point where the user clicked. You can change that 50 to a bigger value to increase your precision, if you want a finer step...

I hope this helps.
Reply With Quote
  #6  
Old 11-05-2007, 05:22
Wolfgang
Guest
 
Posts: n/a
Default

Here is what I came up with. For me it works fine. Thanks to all!!!

Code:
Sub PerpendicularLine()
    Dim x As Double, y As Double
    Dim x0 As Double, y0 As Double, r As Double, n As Long, r0 As Double
    Dim dx As Double, dy As Double
    Dim a2 As Double
    Dim offs As Double
    
    Dim Shift As Long
    
    Dim s As Shape
    Dim sel As Shape
       
    Dim seg As Segment
    Dim seg0 As Segment
        
    If Documents.Count = 0 Then
        MsgBox "No document open.", vbCritical
        Exit Sub
    End If
    
    While ActiveDocument.GetUserClick(x, y, Shift, 1000, True, cdrCursorSmallcrosshair) = 0
        
        Set sel = ActiveDocument.ActivePage.SelectShapesAtPoint(x, y, False)

        If sel.Shapes.Count > 0 Then
            Set s = sel.Shapes(1)
       
            If s.Type = cdrCurveShape Then
            
                If s.IsOnShape(x, y) = cdrOnMarginOfShape Then
                    r = 1E+50
                    Set seg0 = Nothing
                    For Each seg In s.Curve.Segments
                        For n = 0 To 49
                            seg.GetPointPositionAt x0, y0, n / 50, cdrParamSegmentOffset
            
                            x0 = x0 - x
                            y0 = y0 - y
                            r0 = x0 * x0 + y0 * y0
                            If r0 < r Then
                                r = r0
                                Set seg0 = seg
                                offs = n / 50
                            End If
                        Next n
                    Next seg
        
                    a2 = seg0.GetPerpendicularAt(offs, cdrParamSegmentOffset) * 3.1415926 / 180
                    dx = 0.5 * Cos(a2)
                    dy = 0.5 * Sin(a2)
                    
                    With ActiveLayer.CreateLineSegment(x - dx / 2, y - dy / 2, x + dx / 2, y + dy / 2)
                        .Outline.EndArrow = ArrowHeads(1)
                    End With
                    
                    ActiveDocument.ClearSelection
                End If
            End If
        End If
    Wend
End Sub
Wolfgang
Reply With Quote
  #7  
Old 28-10-2011, 11:53
buga buga is offline
Senior Member
 
Join Date: Jan 2011
Posts: 114
Default

Please ask a question.

How do I control the length of the line?

I wish they were created lines of 10mm

Please would greatly appreciate your help

a greeting
Reply With Quote
Reply


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
Urgent: Alex please Help amollondhe CorelDRAW/Corel DESIGNER VBA 3 27-01-2006 20:58
How to draw a double line in coreldraw? 4gold General 11 01-11-2005 18:39
Vector data from Paint to Draw 12? jimmr General 4 26-05-2005 06:24
counting curve and line segments bbolte CorelDRAW/Corel DESIGNER VBA 1 31-01-2005 17:40
I can't let the text on a curve line Dino CorelDRAW/Corel DESIGNER VBA 2 11-04-2003 04:13


All times are GMT -5. The time now is 10:32.


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