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