内容发布更新时间 : 2024/4/28 16:51:55星期一 下面是文章的全部内容请认真阅读。

P2 = C * 3600 + D * 60 + E P3 = 180# * 3600#

P4 = M * 3600 + N * 60 + L

If (P4 = 0) Then Z = P2 Else

Z = P2 + P4 + P3 End If

S = 360# * 3600# If (Z > (2 * S)) Then T = Z - (2 * S) ElseIf (Z > S) Then T = Z - S Else T = Z End If

T3 = 648000

Q1 = T3 / P1 ' 一弧度是多少秒 G = (P1 / P3) * T H = A + F * Cos(G) P = B + F * Sin(G) A1 = NNN(H, 3) B1 = NNN(P, 3) TTAN = G * Q1

TTAND = Fix(TTAN / 3600) '求取度数

TTANF = Fix((TTAN / 3600 - TTAND) * 60) '求取分数

TTANM = (((TTAN / 3600) - TTAND) * 60 - TTANF) * 60 '求取秒值 T6 = NNN(TTANM, 0) If (T6 = 60) Then T6 = 0

TTANF = TTANF + 1 End If

If (TTANF = 60) Then TTANF = 0

TTAND = TTAND + 1 End If

Text8.Text = Str(A1) '此处输出求得的坐标x Text9.Text = Str(B1) '此处输出求得的坐标y Text10.Text = TTAND Text11.Text = TTANF Text12.Text = T6

End Sub

Private Function NNN(E As Double, F As Integer) As Double

Dim M As Integer: '***保存符号*** Dim N As Double Dim Q As Double Dim K As Integer Dim S As Integer

M = Sgn(E): '***保存符号*** N = Abs(E): '***取绝对值***

Q = Fix(N * 10 ^ (F + 1)) - 10 * Fix(N * 10 ^ F): '***要保留位数的后一位***

S = Fix(N * 10 ^ F) - 10 * Fix(N * 10 ^ (F - 1)): '***所要保留的数的最后一位*** If Q > 5 Then K = 1

ElseIf Q < 5 Then K = 0

ElseIf (Q = 5 And S = 2 * Fix(S / 2)) Then K = 0 Else K = 1 End If

NNN = M * (Fix(N * 10 ^ F + K) / 10 ^ F) End Function

6

坐标反算程序部分源代码如下： ????????????

Private Function TTAB(ByVal DX12 As

Double, ByVal DY12 As Double) As Double Rem ***** 坐标反算函数 *****

Dim I As Integer I = 10

If DX12 = 0 And DY12 = 0 Then '***** 1、2为同一点，TTAB无意义，应返回-1值 I = 0

ElseIf DX12 > 0 And DY12 = 0 Then '***** 1、2两点依次位于正向的纵轴上，TTAB=0° I = 1

ElseIf DX12 > 0 And DY12 > 0 Then '***** TTAB位于第一象限 I = 2

ElseIf DX12 = 0 And DY12 > 0 Then '***** 1、2两点依次位于正向的横轴上，TTAB=90° I = 3

ElseIf DX12 < 0 And DY12 > 0 Then '***** TTAB位于第二象限 I = 4

ElseIf DX12 < 0 And DY12 = 0 Then '***** 1、2两点依次位于负向的纵轴上，TTAB=180° I = 5

ElseIf DX12 < 0 And DY12 < 0 Then '***** TTAB位于第三象限 I = 6

ElseIf DX12 = 0 And DY12 < 0 Then '*****1、2两点依次位于负向的横轴上，TTAB=270° I = 7

ElseIf DX12 > 0 And DY12 < 0 Then '***** TTAB位于第四象限 I = 8

Else '***** 当输入数据含有非数字的字符时，TTAB无意义，应返回-1值 I = 10 End If

Select Case I Case 0

TTAB = -1 Case 1

TTAB = 0 Case 2

TTAB = Atn(DY12 / DX12) Case 3

TTAB = PI() / 2 Case 4

TTAB = PI() + Atn(DY12 / DX12) Case 5

TTAB = PI() Case 6

TTAB = PI() + Atn(DY12 / DX12) Case 7

TTAB = 3 * PI() / 2 Case 8

TTAB = 2 * PI() + Atn(DY12 / DX12) Case 9

TTAB = -1 End Select

End Function

??????????????

7

（5）其他程序源代码见下图：

8