VB程序.doc

附和导线程序页面设计Private Sub Command1_Click()Dim ax As DoubleDim ay As DoubleDim bx As DoubleDim by As DoubleDim cx As DoubleDim cy As DoubleDim dx As DoubleDim dy As DoubleDim wzs As DoubleDim qfwj As DoubleDim zfwj As DoubleDim wza As Doubleax = Val(Text1.Text)ay = Val(Text2.Text)bx = Val(Text3.Text)by = Val(Text4.Text)cx = Val(Text5.Text)cy = Val(Text6.Text)dx = Val(Text7.Text)dy = Val(Text8.Text)wza = Val(Text9.Text)wzs = wza + 2Call ZBFS(ax, ay, bx, by, qfwj)Call ZBFS(cx, cy, dx, dy, zfwj)Text12.Text = qfwjText13.Text = zfwjpi = 3.1415926jiao = Split(Text10.Text, ,)qfwj = DFMtoHD(qfwj)zfwj = DFMtoHD(zfwj)Dim fw As Doublefw = qfwjFor I = LBound(jiao) To UBound(jiao)Dim a As Doublea = Val(jiao(I)fw = fw + pi - DFMtoHD(a)If fw 2 * pi Thenfw = fw - 2 * piElseIf fw 2 * pi Then fa = fa - 2 * pi ElseIf fa kk ThenElseEnd IfDim xzz() As DoubleReDim xzz(LBound(bian) To UBound(bian) As DoubleDim yzz() As DoubleReDim yzz(LBound(bian) To UBound(bian) As DoubleFor d = LBound(bian) To UBound(bian)Dim xz As DoubleDim yz As Doublexz = f(d) - fx * b / hsyz = f1(d) - fy * b / hsxz = Int(xz * 1000 + 0.5) / 1000yz = Int(yz * 1000 + 0.5) / 1000xzz(d) = xzyzz(d) = yzNext dDim x As DoubleDim y As Doublex = bxy = byPicture1.Print X坐标Picture2.Print Y坐标For v = LBound(bian) To UBound(bian)x = x + xzz(v)y = y + yzz(v)Picture1.Print xPicture2.Print yNext vEnd SubPrivate Function DFMtoHD(dfm As Double) As DoubleDim fuhao As IntegerDim du As DoubleDim fen As DoubleDim miao As DoubleConst pi = 3.1415926fuhao = Sgn(dfm)dfm = Abs(dfm)du = Int(dfm)fen = Int(dfm - du) * 100)miao = Int(dfm - du) * 100 - fen) * 1000) / 10DFMtoHD = fuhao * (du + fen / 60 + miao / 3600) * pi / 180End FunctionPrivate Function HDtoDFM(hudu As Double) As DoubleDim fuhao As IntegerDim du As DoubleDim fen As DoubleDim miao As DoubleConst pi = 3.1415926fuhao = Sgn(hudu)hudu = Abs(hudu) * 180 / pidu = Int(hudu)fen = Int(hudu - du) * 60)miao = Int(hudu - du) * 60 - fen) * 600 + 0.5) / 10HDtoDFM = fuhao * (du + fen / 100 + miao / 10000)End Function平曲线程序页面设计程序代码Private Sub Command1_Click()Dim xb As DoubleDim yb As DoubleDim xh As DoubleDim YH As DoubleDim blc As DoubleDim pj As DoubleDim pjbz As IntegerDim R As DoubleDim l0 As DoubleConst pi = 3.1415926xb = Val(Text1.Text)yb = Val(Text2.Text)xh = Val(Text3.Text)YH = Val(Text4.Text)blc = Val(Text5.Text)pj = Val(Text6.Text)R = Val(Text7.Text)l0 = Val(Text8.Text)If Option1.Value = True Thenpjbz = 1Elsepjbz = 2End IfDim B0 As DoubleDim m As DoubleDim p As DoubleB0 = l0 / (2 * R) m = l0 / 2 - l0 3 / (240 * R 2)p = l0 2 / (24 * R)Dim T As DoubleDim L As DoubleDim E0 As DoubleDim q As Doublepj = dfmtohd(pj)T = (R + p) * Tan(pj / 2) + mL = 2 * l0 + R * (pj - 2 * B0)E0 = (R + p) * (1 / Cos(pj / 2) - Rq = 2 * T - LDim ZH As DoubleDim HY As DoubleDim QZ As DoubleDim YHD As DoubleDim HZ As DoubleZH = blc - THY = ZH + l0QZ = ZH + L / 2YHD = ZH + L - l0HZ = ZH + LDim Xzh As DoubleDim Yzh As DoubleDim Xhz As DoubleDim Yhz As DoubleDim Xhy As DoubleDim Yhy As DoubleDim JZ As DoubleDim fwj As DoubleDim jl As DoubleDim x As DoubleDim y As DoubleDim Xi As DoubleDim qi As DoubleDim zhong As Doubleqi = Val(Text9.Text)zhong = Val(Text10.Text)For i = qi To zhong Step 10JZ = iCall ZBFS(xb, yb, xh, YH, fwj, jl)fwj = dfmtohd(fwj)If JZ HZ Thenx = xb + (JZ - HZ + T) * Cos(fwj)y = yb + (JZ - HZ + T) * Sin(fwj)ElseIf JZ YHD ThenXhz = xb + T * Cos(fwj)Yhz = yb + T * Sin(fwj)Xi = (HZ - JZ) - (HZ - JZ) 5 / (40 * R 2 * l0 2)If pjbz = 1 Thenx = Xhz + Xi * Cos(fwj + pi + (HZ - JZ) 2 / (6 * R * l0) / Cos(HZ - JZ) 2 / (6 * R * l0)y = Yhz + Xi * Sin(fwj + pi + (HZ - JZ) 2 / (6 * R * l0) / Cos(HZ - JZ) 2 / (6 * R * l0)Elsex = Xhz + Xi * Cos(fwj + pi - (HZ - JZ) 2 / (6 * R * l0) / Cos(HZ - JZ) 2 / (6 * R * l0)y = Yhz + Xi * Sin(fwj + pi - (HZ - JZ) 2 / (6 * R * l0) / Cos(HZ - JZ) 2 / (6 * R * l0)End IfElseIf JZ HY ThenXzh = xb + T * Cos(fwj - (pi - pj)Yzh = yb + T * Sin(fwj - (pi - pj)Xi = l0 - l0 5 / (40 * R 2 * l0 2)Xhy = Xzh + Xi * Cos(fwj + pj - l0 2 / (6 * R * l0) / Cos(l0 2 / (6 * R * l0)Yhy = Yzh + Xi * Sin(fwj + pj - l0 2 / (6 * R * l0) / Cos(l0 2 / (6 * R * l0)If pjbz = 1 Thenx = Xhy + 2 * R * Sin(JZ - HY) / (2 * R) * Cos(fwj + pj - (JZ - HY + l0) / (2 * R)y = Yhy + 2 * R * Sin(JZ - HY) / (2 * R) * Sin(fwj + pj - (JZ - HY + l0) / (2 * R)Elsex = Xhy + 2 * R * Sin(JZ - HY) / (2 * R) * Cos(fwj + pj + (JZ - HY + l0) / (2 * R)y = Yhy + 2 * R * Sin(JZ - HY) / (2 * R) * Sin(fwj + pj + (JZ - HY + l0) / (2 * R)End IfElseIf JZ ZH ThenXzh = xb + T * Cos(fwj - (pi - pj)Yzh = yb + T * Sin(fwj - (pi - pj)Xi = (JZ - ZH) - (JZ - ZH) 5 / (40 * R 2 * l0 2)If pjbz = 1 Thenx = Xzh + Xi * Cos(fwj + pj - (JZ - ZH) 2 / (6 * R * l0) / Cos(JZ - ZH) 2 / (6 * R * l0)y = Yzh + Xi * Sin(fwj + pj - (JZ - ZH) 2 / (6 * R * l0) / Cos(JZ - ZH) 2 / (6 * R * l0)Elsex = Xzh + Xi * Cos(fwj + pj + (JZ - ZH) 2 / (6 * R * l0) / Cos(JZ - ZH) 2 / (6 * R * l0)y = Yzh + Xi * Sin(fwj + pj + (JZ - ZH) 2 / (6 * R * l0) / Cos(JZ - ZH) 2 / (6 * R * l0)End IfElsex = xb + (ZH - JZ + T) * Cos(fwj - (pi - pj)y = yb + (ZH - JZ + T) * Sin(fwj - (pi - pj)End IfText11.Text = Text11.Text & i & Text11.Text = Text11.Text & Int(x * 1000 + 0.5) / 1000 & Text11.Text = Text11.Text & Int(y * 1000 + 0.5) / 1000 & Chr(13) & Chr(10)Next iEnd SubPrivate Function dfmtohd(dfm As Double) As DoubleDim fuhao As IntegerDim du As IntegerDim fen As IntegerDim miao As DoubleConst pi = 3.1415926fuhao = Sgn(dfm)dfm = Abs(dfm)du = Int(dfm)fen = Int(dfm - du) * 100)miao = Int(dfm - du) * 100 - fen) * 1000) / 10dfmtohd = fuhao * (du + fen / 60 + miao / 3600) * pi / 180End FunctionPrivate Sub ZBFS(xa As Double, ya As Double, xb As Double, yb As Double, fwj As Double, pj As Double)Dim dx As DoubleDim dy As DoubleConst pi = 3.1415926dx = xb - xady = yb - yadx = xb - xady = yb - yaIf dx = 0 And dy 0 Th