gaosi.bas

坐标换代程序。可以进行54北京和80北京坐标转换

Attribute VB_Name = "gaosi"
Sub hd(QA, ZX, f, JINGDU, WEIDU, L0, L1, L2, X, Y0, XXX, YYY, rrr, I)

 RA = 57.29577951

'给经度纬度、坐标赋值
   If QA = 1 Then
  B = WEIDU:  DEG = B:  GoSub DE:  B = DEG
  G = JINGDU: DEG = G:  GoSub DE:  G = DEG
  End If
   
  If QA = 2 Then X1 = X:   E = Y0

  If QA = 3 Then X1 = X:   E = Y0
    
  If QA <= 2 Then A = L0:     JA = A

  If QA <= 2 Then DEG = A:   GoSub DE:  A = DEG:  D = A
  
  If QA = 3 Then
  A = L1:  JA = A:  D = L2:  JD = D:  DEG = A
  GoSub DE
  A = DEG:  DEG = D: GoSub DE: D = DEG
  End If

   GoSub PA
3:  If QA <> 1 Then GoTo 4
  BI = Int(B): BF = B - BI: L = G - D: W = L / RA
  GoSub BX: DMS = B: GoSub DM: B = DMS: DMS = G: GoSub DM: G = DMS
  GoSub PB:  X = X2: Y = Y2: GoSub PC
  GoSub PD: GoTo 6
4:  If QA <> 2 Then GoTo 5
  GoSub XB:   X = X1: Y = E
  GoSub PC: S = A: DMS = (BI + BF): GoSub DM: B = DMS:
  DMS = A + L: GoSub DM: G = DMS: GoSub PB: GoTo 6
5:  GoSub XB: S = D - A: W = (L - S) / RA: GoSub BX
   X = X1: Y = E: GoSub PC:  XXX = X2: YYY = Y2 + f: GoSub PC: GoSub PD: GoTo 6
6: Exit Sub

XB: E = E - f: Z = E * E: For J = 1 To 6: GoSub BZ
  BI = Int(B): BF = (X1 + Q) / B0 - BI
  B = BI + BF: Next J: GoSub XA
  D4 = 5 + U * (3 - 9 * H) + H - Z / 30 / M * (61 + 45 * U * (2 + U))
  BF = BF - (1 + H) * T * Z * RA / 2 / M * (1 - Z / 12 / M * D4)
  B = BI + BF
  C1 = 1 + 2 * U + H: C2 = 5 + H * (6 + 8 * U) + U * (28 + 24 * U)
  C3 = 61 + U * (662 + U * (1320 + 720 * U))
  L = 1 - Z / 6 / M * (C1 - Z / 20 / M * (C2 - Z / 42 / M * C3))
  L = E * RA / N / C * L
  Return
BX: K = W * W: GoSub XA: X4 = 5 - U + H * (9 + 4 * H)
  X6 = 61 + U * (U - 58)
  Y3 = 1 - U + H: Y5 = 5 + H * (14 - 58 * U) + U * (U - 18)
  R3 = 1 + H * (3 + 2 * H): R5 = 2 - U: GoSub BZ
  X2 = T * N * V * K / 6 * (3 + V * K / 4 * (X4 + V * K / 30 * X6))
  X2 = B0 * (BI + BF) - Q + X2
  Y2 = N * C * W * (1 + V * K / 6 * (Y3 + V * K / 20 * Y5))
  R = W * RA * T * C * (1 + V * K / 3 * (R3 + V * K / 5 * R5))
  Return
XA: C = Cos(B / RA): T = Tan(B / RA): V = C * C: U = T * T
  If ZX = 54 Then H = 0.006738525415 * V: N = 6399698.902 / Sqr(1 + H)
  If ZX = 54 Then M = N * N: Return
  H = 0.006739501817 * V: N = 6399596.652 / Sqr(1 + H): M = N * N: Return
BZ: If ZX = 80 Then GoTo 7
   Q = 16036.48027 * Sin(2 * B / RA) - 16.82806688 * Sin(4 * B / RA)
   Q = Q + 0.0219753 * Sin(6 * B / RA): Return
7:  Q = 16038.52817 * Sin(2 * B / RA) - 16.83168626 * Sin(4 * B / RA)
   Q = Q + 0.0219629 * Sin(6 * B / RA): Return
PA: If ZX = 80 Then Else GoTo 8
   B0 = 111133.004681: GoTo 9
8: B0 = 111134.861084
9:
   If QA = 3 Then GoTo 10
   L8 = JA: GoSub CV: Return
10: L8 = JA: GoSub CV
    L8 = JD: GoSub CV:  Return
PB: WEIDU = B: GoSub CU
    JINGDU = G: GoSub CU
   Return
PC: Y0 = Y + f
   Return
PD: DMS = Abs(R + 0.000000001): GoSub DM: L9 = DMS
   If R > 0 Then GoSub CU
   If R < 0 Then GoSub CU: rrr = "-" & rrr
   Return
CV: K8 = CInt(L8): J8 = CInt((L8 - K8) * 100)
   I8 = CInt(((L8 - K8) * 100 - J8) * 100)
   If I8 = 60 Or I8 = 100 Then J8 = J8 + 1: I8 = 0
   If J8 = 60 Or J8 = 100 Then K8 = K8 + 1: J8 = 0

CU:  K9 = Int(L9): J9 = Int((L9 - K9) * 100)
   I9 = ((L9 - K9) * 100 - J9) * 100
   If I9 = 60 Or I9 = 100 Then Let J9 = J9 + 1: I9 = 0
   If J9 = 60 Or J9 = 100 Then Let K9 = K9 + 1: J9 = 0
   rrr = Str(" " & K9) & " " & Str(" " & J9) & "" & Str(" " & I9)
   Return
DE: DEG4 = Sgn(DEG): DEG = Abs(DEG + 0.00000001)
  DEG1 = Int(DEG)
  DEG2 = Int((DEG - DEG1) * 100) / 60
  DEG3 = ((DEG * 100 - Int(DEG * 100)) * 100) / 3600
  DEG = DEG4 * (DEG1 + DEG2 + DEG3)
  Return
DM: DMS4 = Sgn(DMS): DMS = Abs(DMS + 0.00000001): DMS1 = Int(DMS)
  DMS2 = (DMS - DMS1) * 100 * 0.6
  DMS3 = (DMS2 - Int(DMS2)) * 100 * 0.6
  DMS = DMS4 * (DMS1 + Int(DMS2) / 100 + DMS3 / 10000)
  Return
End Sub