椭圆数据处理.bas

一个附和导线的严密计算平差程序

Attribute VB_Name = "ModTYShujuCL"
Type ZBPic          '坐标在图片框上坐标记录类型
     y As Single
     x As Single
     T As Single
     
End Type
Public ZBP() As ZBPic      '坐标在图片框上坐标数组

Public Sub QiuTYdianXY(PW As Single, PH As Single)     '求椭圆圆心点坐标在图片框中坐标
  Dim Xmin As Double
  Dim Ymin As Double
  Dim Xmax As Double
  Dim Ymax As Double
  Dim Xrea As Double     '在X方向最大坐标于最小坐标之差
  Dim Yrea As Double     '在Y方向最大坐标于最小坐标之差
  Dim Xtu As Single       '根据所选的比例尺在图片框中沿X轴的大小
  Dim Ytu As Single       '根据所选的比例尺在图片框中沿Y轴的大小
  Dim TBH As Single
  Dim TBW As Single
  Dim TB As Single
  Xmax = ZBJG(1).y
  Xmin = Xmax
  Ymax = ZBJG(1).x
  Ymin = Ymax
  For i = 2 To IntCount
    With ZBJG(i)
       If .x < Ymin Then
         Ymin = .x
       End If
       If .x > Ymax Then
         Ymax = .x
       End If
       If .y > Xmax Then
         Xmax = .y
       End If
       If .y < Xmin Then
         Xmin = .y
       End If
    End With
  Next i
  'Debug.Print Xmin, Ymin, Xmax, Ymax
  Xrea = (Xmax - Xmin) * 1.3
   Yrea = (Ymax - Ymin) * 1.3
   TBH = PW / Xrea
   TBW = PH / Yrea
   If TBH > TBW Then
    TB = TBW
     Else
     TB = TBH
   End If
 ReDim ZBP(IntCount)
 For i = 1 To IntCount
   With ZBP(i)
       .x = Int((ZBJG(i).y - Xmin) * TB)
       .y = Int((ZBJG(i).x - Ymin) * TB)
   End With
   
 Next i
End Sub

Public Sub Huaxian()
 ' Dim t0 As Single
 ' t0 = DFMDu(aa(1))
 ' t0 = t0 + 180
  'If t0 > 360 Then
  ' t0 = t0 - 360
  ' End If
    
 ' frmHuaTuoYuan.PicHuaTuoYuan.Line (ZBP(1).X, ZBP(1).Y)-(ZBP(1).X + 15 * Cos(DuHudu(t0)), ZBP(1).Y + 15 * Sin(DuHudu(t0))), RGB(255, 0, 0)
 ' frmHuaTuoYuan.PicHuaTuoYuan.Line (ZBP(1).X, ZBP(1).Y)-(ZBP(1).X + 5 * Cos(DuHudu(t0 - 30)), ZBP(i).Y + 5 * Sin(DuHudu(t0 - 30))), RGB(255, 0, 0)
 ' frmHuaTuoYuan.PicHuaTuoYuan.Line (ZBP(1).X, ZBP(1).Y)-(ZBP(1).X + 2 * Cos(DuHudu(t0 + 30)), ZBP(i).Y + 2 * Sin(DuHudu(t0 + 30))), RGB(255, 0, 0)
  For i = 1 To IntCount - 1
    frmHuaTuoYuan.PicHuaTuoYuan.Line (ZBP(i).x, ZBP(i).y)-(ZBP(i + 1).x, ZBP(i + 1).y), QBColor(13)
  Next i
End Sub

Public Sub HuaDiantuoyuan(Px As Single, Py As Single, ByVal PE As Single, ByVal PF As Single, PT As Double, xm As Integer)      '画误差椭圆
 Dim Q As Double
 Dim xt As Single
 Dim Zuan(2, 2) As Single
 Dim TYxy(360, 2) As Single
 Dim KTYxy(360, 2) As Single
 ' PT = DFMDu(PT)
  'If PT <= 90 Then
  ' Q = 90 - PT
  ' Else
  ' Q = 270 - PT
  'End If
  Q = DFMDu(PT) - 90
  'Debug.Print Q
  Zuan(1, 1) = Cos(DuHudu(Q))
  Zuan(1, 2) = -Sin(DuHudu(Q))
  Zuan(2, 1) = Sin(DuHudu(Q))
  Zuan(2, 2) = Cos(DuHudu(Q))
  j = InStr(frmHuaTuoYuan.CboTuoyuanBili.Text, ":")
  xt = Val(Left$(frmHuaTuoYuan.CboTuoyuanBili.Text, j - 1)) / Val(Mid(frmHuaTuoYuan.CboTuoyuanBili.Text, j + 1))
  PE = PE * xt
  PF = PF * xt
  For i = 1 To 360
    KTYxy(i, 1) = PE * Cos((2 * PI / 360) * i)
    KTYxy(i, 2) = PF * Sin((2 * PI / 360) * i)
  Next i
  For i = 1 To 360
   For j = 1 To 2
    If j = 1 Then
       TYxy(i, j) = Px
       Else
       TYxy(i, j) = Py
    End If
    For m = 1 To 2
      TYxy(i, j) = TYxy(i, j) + KTYxy(i, m) * Zuan(m, j)
    Next m
   Next j
  Next i
   
  For i = 1 To 359
    frmHuaTuoYuan.PicHuaTuoYuan.Line (TYxy(i, 1), TYxy(i, 2))-(TYxy(i + 1, 1), TYxy(i + 1, 2)), QBColor(xm)
  Next i
 
 ' frmHuaTuoYuan.PicHuaTuoYuan.Circle (Px, Py), 3, QBColor(4)
End Sub