Calculating Angle Variation

 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