Hi all,
It's been a while since I've posted as I started a new job using AutoCAD but by showing the power of CorelDraws API to my new employer I am back again!... with more questions!
I've Hit a block with probably a quite simple (but fun) problem but for the life of me an elegant and robust solution eludes me!
In short I want to analyse the a curve, recording the perpendicular angle at a series of points along it.
Then give each recorded point a value between 0-180 based on how much it deviates from my target angle.
Currently It only works correctly when the angle is 0, please see below for the stripped down block of code and an image of its current output to get things moving.
All suggestions and ideas welcome.
Thanks in advance
Sub PerpLines() ActiveDocument.Unit = cdrMillimeter Dim S As Shape Set S = ActiveShape Dim Sp As SubPath Set Sp = S.Curve.SubPaths.First Dim P As Shape Dim L As Long: L = 1 Dim step As Long: step = 10 Dim curLength As Double: curLength = 0 Dim sLength As Double: sLength = Sp.Length Dim X As Double, Y As Double, A As Double Dim R As Double Dim targA As Double: targA = 90 Dim aDif As Double Do While curLength < sLength - step curLength = curLength + step Sp.GetPointPositionAt X, Y, curLength, cdrAbsoluteSegmentOffset A = Sp.GetPerpendicularAt(curLength, cdrAbsoluteSegmentOffset) Set P = ActiveLayer.CreateLineSegment(X, Y, X + step, Y) P.Outline.EndArrow = ArrowHeads(1) P.Outline.Width = 1 P.SetRotationCenter X, Y P.Rotate A
If A < 0 Then aDif = A + 360 Else aDif = A End If R = (255) * (Abs(A) / 180) P.Outline.Color.RGBAssign CLng(R), 50, 50 P.Name = CStr(aDif) L = L + 1 Set P = Nothing Loop End Sub
Hiya, Howard. Long time no see!
I have on several occasions gotten tangled up when trying to compare angles. I eventually muddle my way through it!
For what I think you are trying to do, this seems to work for me. There may be some much more clever / efficient ways to do it.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
Sub PerpLines() ActiveDocument.Unit = cdrMillimeter Dim S As Shape Set S = ActiveShape Dim Sp As SubPath Set Sp = S.Curve.SubPaths.First Dim P As Shape Dim L As Long: L = 1 Dim step As Long: step = 10 Dim curLength As Double: curLength = 0 Dim sLength As Double: sLength = Sp.Length Dim X As Double, Y As Double, A As Double Dim R As Double Dim targA As Double: targA = 0 Dim aDif As Double Dim dblDifForColor As Double Do While curLength < sLength - step curLength = curLength + step Sp.GetPointPositionAt X, Y, curLength, cdrAbsoluteSegmentOffset A = Sp.GetPerpendicularAt(curLength, cdrAbsoluteSegmentOffset) Set P = ActiveLayer.CreateLineSegment(X, Y, X + step, Y) P.Outline.EndArrow = ArrowHeads(1) P.Outline.Width = 1 P.SetRotationCenter X, Y P.Rotate A 'something new aDif = abs_angle_difference(targA, A) If aDif > 180 Then dblDifForColor = 360 - aDif Else dblDifForColor = aDif End If R = (255) * (dblDifForColor / 180) ' P.Outline.Color.RGBAssign CLng(R), 50, 50 P.Name = CStr(aDif) L = L + 1 Set P = Nothing Loop End Sub Function abs_angle_difference(ByVal Angle_A As Double, ByVal Angle_B As Double) As Double Dim dblAngle_A_pos As Double Dim dblAngle_B_pos As Double Dim dblAbsRawDiff As Double dblAngle_A_pos = angle_positive(Angle_A) dblAngle_B_pos = angle_positive(Angle_B) dblAbsRawDiff = Abs(dblAngle_B_pos - dblAngle_A_pos) If dblAbsRawDiff > 180 Then abs_angle_difference = 360 - dblAbsRawDiff Else abs_angle_difference = dblAbsRawDiff End If End Function Function angle_positive(ByVal Angle As Double) As Double If Angle < 0 Then angle_positive = Angle + 360 Else angle_positive = Angle End If End Function