module1.bas

来自「gps控制网设计 gps控制网设计 gps控制网设计」· BAS 代码 · 共 84 行

Attribute VB_Name = "Module1"
Private Type Kzdxx
 dh As Integer
  Name As String
  X As Single
  Y As Single
End Type

Public ii As Integer
Public wdxy() As Kzdxx
Type wx
   bh As Integer
   dh1 As Integer
   dh2 As Integer
End Type
Public wxsj() As wx
Public jj As Integer
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public wtbl As Long
Public tybl As Long
Public yzdgs As Integer     '已知点个数
Public bca%, bcb%, bcc%, bcd%   '仪器标称精度
Public Kzwmc As String            '控制网名称
Public newfilename As String
Public tydx As Integer  '调整椭圆大小
'找所选点号
Public Function zwdh(X As Single, Y As Single, kd() As Kzdxx, k As Integer) As Integer
     Dim i As Integer
     For i = 1 To k
       jl = Sqr((X - kd(i).X) ^ 2 + (Y - kd(i).Y) ^ 2)
       If jl <= 150 * frmkzwsj.dqbl Then
         zwdh = i
         Exit Function
       End If
      Next i
End Function

'找所选边号
Public Function zjxh(x1 As Single, y1 As Single, kd() As Kzdxx, W() As wx, q As Integer) As Integer
    Dim i As Integer
    Dim s() As Single
   Dim s1() As Single
   Dim jl() As Single
   Dim aa As Single
   Dim cc As Single
    ReDim s(1 To q)
    ReDim s1(1 To q)
    ReDim jl(1 To q)
    For i = 1 To q
       aa = (kd(W(i).dh1).Y - kd(W(i).dh2).Y) / (kd(W(i).dh2).X - kd(W(i).dh1).X)
       cc = (kd(W(i).dh1).X * kd(W(i).dh2).Y - kd(W(i).dh2).X * kd(W(i).dh1).Y) / (kd(W(i).dh2).X - kd(W(i).dh1).X)
      s(i) = Abs(aa * x1 + y1 + cc) / (aa * aa + 1) ^ 0.5
      s1(i) = Sqr((x1 - (kd(W(i).dh1).X + kd(W(i).dh2).X) / 2) ^ 2 + (y1 - (kd(W(i).dh1).Y + kd(W(i).dh2).Y) / 2) ^ 2)
      jl(i) = Sqr((kd(W(i).dh1).X - kd(W(i).dh2).X) ^ 2 + (kd(W(i).dh1).Y - kd(W(i).dh2).Y) ^ 2)
   Next i
    For i = 1 To q
      If s(i) < 100 * frmkzwsj.dqbl And s1(i) < jl(i) / 2 Then
         min1 = s1(i)
         zjxh = i
         Exit For
       End If
    Next i
End Function



Sub Cgdy(filename As String)
   Dim X
   X = Shell("c:\Wordpad " + filename, 1)
End Sub
'根据两端点号找基线
Public Function zjxh2(qdh As Integer, zdh As Integer, ww() As wx, nb As Integer) As Integer
  Dim i%
  For i = 1 To nb
    If ww(i).dh1 = qdh Or ww(i).dh2 = qdh Then
       If ww(i).dh1 = zdh Or ww(i).dh2 = zdh Then
         zjxh2 = i
         Exit For
       End If
    End If
  Next i
End Function