OberonPlace.com Forums > VBA How to draw a line perpendicular to a curve
 Blogs Gallery FAQ Members List Social Groups Calendar Search Today's Posts Mark Forums Read

#1
03-05-2007, 08:11
 Wolfgang Guest Posts: n/a
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.
#2
09-05-2007, 10:01
 Wolfgang Guest Posts: n/a

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.

Wolfgang
#3
09-05-2007, 15:39
 wOxxOm Senior Member Join Date: Mar 2005 Posts: 836

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 :-)
#4
10-05-2007, 04:19
 Wolfgang Guest Posts: n/a

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
#5
10-05-2007, 07:35
 Alex Administrator Join Date: Nov 2002 Posts: 1,940 Blog Entries: 4

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.
#6
11-05-2007, 05:22
 Wolfgang Guest Posts: n/a

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)
End With

ActiveDocument.ClearSelection
End If
End If
End If
Wend
End Sub```
Wolfgang
#7
28-10-2011, 11:53
 buga Senior Member Join Date: Jan 2011 Posts: 114

How do I control the length of the line?

I wish they were created lines of 10mm

a greeting

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

 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 Rules
 Forum Jump User Control Panel Private Messages Subscriptions Who's Online Search Forums Forums Home OberonPlace Discussion     Site News     Web site suggestions     Image Gallery     Testing Oberon Products     CurveWorks     SecuriDesign     Calendar Wizard     Oberon Function Plotter     Jigsaw Puzzle Creator     Other Oberon Commercial Products     New product ideas Corel User Forums     CorelDRAW         General         Tutorials         FAQ         Feature requests/wishlist         Macros/Add-ons         Artwork Showcase     Corel DESIGNER         General         Tutorials         FAQ         Feature requests/wishlist         Macros/Add-ons         Artwork Showcase     Corel PHOTO-PAINT         General         Tutorials         FAQ         Feature requests/wishlist         Macros/Add-ons         Artwork Showcase     General         About Corel         Off-Topic Developer Forums     OberonPlace Development Portal     VBA         CorelDRAW/Corel DESIGNER VBA         Corel Photo-Paint VBA         Code Critique     Corel Script         CorelDRAW CS         Corel Photo-Paint CS

 Similar Threads Thread Thread Starter Forum Replies Last Post amollondhe CorelDRAW/Corel DESIGNER VBA 3 27-01-2006 20:58 4gold General 11 01-11-2005 18:39 jimmr General 4 26-05-2005 06:24 bbolte CorelDRAW/Corel DESIGNER VBA 1 31-01-2005 17:40 Dino CorelDRAW/Corel DESIGNER VBA 2 11-04-2003 04:13

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

 OberonPlace.com - Archive - Top