form1.frm

用vb6开发的为计算道路等线状,圆和直线计算坐标的程式

Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const SWP_NOSIZE = &H1
    Const SWP_NOMOVE = &H2
    Const SWP_NOACTIVATE = &H10
    Const HWND_TOPMOST = -1
    Const HWND_NOTOPMOST = -2
    Const SWP_SHOWWINDOW = &H40
    Private Declare Function SetWindowPos Lib _
     "user32" (ByVal hwnd As Long, _
     ByVal hWndInsertAfter As Long, ByVal x As Long, _
     ByVal y As Long, ByVal cx As Long, ByVal cy As Long, _
     ByVal wFlags As Long) As Long

Private Sub Command1_Click()
Dim qix As Double, qiy As Double
Dim zox As Double, zoy As Double
Dim juli As Double
Dim i As Long
Dim jiao As Double
Dim d As Double
Dim duanshu As Double
Dim licheng1 As Double, licheng2 As Double
Dim dx As Double, dy As Double
Dim x As Double, y As Double
Dim strchu As String
Dim zongli As Double
dx = 0
dy = 0
x = 0
y = 0




If IsNumeric(T1.Text) And IsNumeric(T2.Text) And IsNumeric(T3.Text) And IsNumeric(T4.Text) And IsNumeric(T5.Text) And IsNumeric(T6.Text) Then
Open App.Path & "\" & "直线平分坐标.txt" For Output As #1

qix = Val(T1.Text)
qiy = Val(T2.Text)
zox = Val(T3.Text)
zoy = Val(T4.Text)
juli = Val(T5.Text)
licheng1 = Val(T6.Text)


licheng2 = licheng1 + juli
jiao = fangwei(qix, qiy, zox, zoy)
d = Ldjuli(qix, qiy, zox, zoy)
duanshu = Int(d / juli)                    '分段数
If duanshu < 1 Or duangshu = 1 Then
ii = MsgBox("对不起，分段距离不对，或坐标不对，请检查后再计算！")
Close #1
Kill App.Path & "\" & "直线平分坐标.txt"
GoTo ccc
End If
strchu = licheng1 & "     " & qix & "   " & qiy & "   " & "0"

Print #1, strchu
For i = 1 To duanshu

dx = dx + juli * Cos(jiao)
dy = dy + juli * Sin(jiao)
x = FormatNumber(qix + dx, 3, vbTrue)
y = FormatNumber(qiy + dy, 3, vbTrue)
strchu = licheng2 & "     " & x & "   " & y & "   " & "0"
Print #1, strchu
licheng2 = licheng2 + juli
x = 0
y = 0

Next i
zongli = Int((licheng1 + d + 0.001) * 1000) / 1000
strchu = zongli & "     " & zox & "   " & zoy & "   " & "0"
Print #1, strchu
Close #1
iii = MsgBox("完成！")
Else
iii = MsgBox("直线计算数据不对，请检查数据！")

End If
ccc:

End Sub

Private Sub Command2_Click()
If IsNumeric(T1.Text) And IsNumeric(T2.Text) And IsNumeric(T3.Text) And IsNumeric(T4.Text) And IsNumeric(T5.Text) And IsNumeric(T6.Text) Then
   If IsNumeric(T7.Text) Or IsNumeric(T8.Text) Then
      If Option1.Value = False And Option2.Value = False Then
         ii = MsgBox("请选择左右弧！")
         Exit Sub
      End If

Dim r As Double, jiaodu As Double, l As Double   '半径，圆心角，弧长
Dim qix As Double, qiy As Double
Dim zox As Double, zoy As Double
Dim juli As Double
Dim duanshu As Double
Dim licheng1 As Double, licheng2 As Double
Dim arf As Double, xuan As Double, qifangwei As Double
Dim strchu As String
Dim dx As Double, dy As Double
Dim x As Double, y As Double
Dim zongli As Double
Dim rr As Double, jjj As Double
dx = 0
dy = 0
 x = 0
 y = 0

Open App.Path & "\" & "弧线平分坐标.txt" For Output As #2

qix = Val(T1.Text)
qiy = Val(T2.Text)
zox = Val(T3.Text)
zoy = Val(T4.Text)
juli = Val(T5.Text)
licheng1 = Val(T6.Text)

r = Val(T7.Text)
rr = r
jiaodu = Val(T8.Text)
jjj = dfm_to_hu(jiaodu)
qifangwei = fangwei(qix, qiy, zox, zoy)   '计算弦的方位角

If qifangwei = 0 Or qifangwei = pi / 2 Or qifangwei = pi Or qifangwei = pi + pi / 2 Then

GoTo cuc
End If



xuan = Ldjuli(qix, qiy, zox, zoy)            '计算弦长

'以下为计算半径或圆心角


If jiaodu <> 0 And r <> 0 Then

rr = xuan / Sin(jjj) * Sin((pi - jjj) / 2)
Dim rrr As Double
rrr = Abs(rr - r)
If rrr > 0.003 Then
ii = MsgBox("半径和转角有一个不对，请检查！检查或用其中一个数据既可！")
Close #2
Kill App.Path & "\" & "弧线平分坐标.txt"
Exit Sub
End If
End If




 
 If jiaodu = 0 Then
  
  jiaodu = (2 * r ^ 2 - xuan ^ 2) / (2 * r ^ 2)
  On Error GoTo ccu
  jiaodu = arccos(jiaodu)
  
    Else
    jiaodu = dfm_to_hu(jiaodu)
 End If
 If r = 0 Then r = xuan / Sin(jiaodu) * Sin((pi - jiaodu) / 2)
 
 
 
 
 

'计算弧长
l = r * jiaodu

duanshu = Int(l / juli)                    '分段数
If duanshu < 1 Or duangshu = 1 Then
ii = MsgBox("对不起，分段距离不对，或坐标不对，请检查后再计算！")
Close #2
Kill App.Path & "\" & "弧线平分坐标.txt"
Exit Sub
End If
licheng2 = licheng1 + juli

'写入开始点
strchu = licheng1 & "     " & qix & "   " & qiy & "   " & "0"
Print #2, strchu
leiji = juli + leiji
'当转角在左时
If Option1.Value = True Then

For i = 1 To duanshu
arf = leiji / r         '一段弧对的圆心角
dwqx = Sqr(2 * r ^ 2 - 2 * r ^ 2 * Cos(arf))          '一段弧的切线的长度
arf = (pi - arf) / 2    '转为一段弧的切线与起始半径的夹角
arf = arf - (pi - jiaodu) / 2         ' 转为一段弧的切线与总切线的夹角
arf = qifangwei - arf                      '一段弧的切切线的方位角
If arf < 0 Then arf = arf + 2 * pi



dx = dwqx * Cos(arf)
dy = dwqx * Sin(arf)
x = FormatNumber(qix + dx, 3, vbTrue)
y = FormatNumber(qiy + dy, 3, vbTrue)
strchu = licheng2 & "     " & x & "   " & y & "   " & "0"
Print #2, strchu
licheng2 = licheng2 + juli
leiji = juli + leiji
x = 0
y = 0
dx = 0
dy = 0

Next i

End If

'当转点在右时
If Option2.Value = True Then

For i = 1 To duanshu
arf = leiji / r         '一段弧对的圆心角
dwqx = Sqr(2 * r ^ 2 - 2 * r ^ 2 * Cos(arf))          '一段弧的切线的长度
arf = (pi - arf) / 2    '转为一段弧的切线与起始半径的夹角
arf = arf - (pi - jiaodu) / 2         ' 转为一段弧的切线与总切线的夹角
arf = arf + qifangwei                        '一段弧的切切线的方位角
If arf > 2 * pi Then arf = arf - 2 * pi


dx = dwqx * Cos(arf)
dy = dwqx * Sin(arf)
x = FormatNumber(qix + dx, 3, vbTrue)
y = FormatNumber(qiy + dy, 3, vbTrue)
strchu = licheng2 & "     " & x & "   " & y & "   " & "0"
Print #2, strchu
licheng2 = licheng2 + juli
leiji = juli + leiji
x = 0
y = 0
dx = 0
dy = 0


Next i

End If
'写入终桩号点
zongli = Int((licheng1 + l + 0.001) * 1000) / 1000
strchu = zongli & "     " & zox & "   " & zoy & "   " & "0"
Print #2, strchu
Close #2
iiip = MsgBox("完成！")

   Else
   iii = MsgBox("半径或角度不对，请检查数据！")
   End If
Else
iii = MsgBox("在左边方框架内有数据不对，请检查数据！")
End If
Exit Sub

cuc:
Close #2
Kill App.Path & "\" & "弧线平分坐标.txt"
iii = MsgBox("弧线过长，或超过一个半圆，请分段计算！")
Exit Sub

ccu:
Close #2
Kill App.Path & "\" & "弧线平分坐标.txt"
iii = MsgBox("半径与角度，坐标等有未知的错误！请检查后再计算！")
Exit Sub
End Sub

Private Sub Form_Load()
Form1.Picture = LoadPicture("")

SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, _
     SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE _
    Or SWP_NOSIZE

End Sub