坐标正反算vb测量程序
坐标反算(VB编程代码)
计算△X，△Y 的值
若△X，△Y 有为零 的，则直接判断方位 角。
若△X，△Y 不为零， 则计算象限角 R。
由象限角判断方 位角
输出方位角α
坐标反Sub Command3_Click() Dim Xa, Ya, Xb, Yb, M, N, Rab, R, F, R1, R2, R3 As Single pi = 3.1415926 Xa = Text1.Text Ya = Text4.Text Xb = Text2.Text Yb = Text5.Text M = Xb - Xa '求纵坐标增量 N = Yb - Ya '求横坐标增量 Rab = Math.Atn(Abs(N / M)) * 180 / pi '计算象限角 If M > 0 And N > 0 Then F = Rab '由象限角判断方位角 If M < 0 And N > 0 Then F = 180 - Rab If M < 0 And N < 0 Then F = 180 + Rab If M > 0 And N < 0 Then F = 360 - Rab If M = 0 And N > 0 Then F = 90 If M = 0 And N < 0 Then F = 270 If N = 0 And M > 0 Then F = 0 If N = 0 And M < 0 Then F = 180 R1 = Fix(F) '把弧度化为度 R2 = Fix((F - R1) * 60) R3 = Fix((((F - R1) * 60) - R2) * 60) Text3.Text = R1 & "°" & R2 & "′" & R3 & "″" Text6 = Sqr(M ^ 2 + N ^ 2) End Sub Private Sub Command2_Click() Text1 = "" Text2 = "" Text3 = "" Text4 = "" Text5 = "" Text6 = "" End Sub
坐标正反算程序
1.坐标反算(ZBFS)主程序XY：N=X: T=Y:Pros"DAT1"W"X0"：S"Y0"：O"K0"：G"F0"：H"KN"：P"R0"：R"RN"：Q”Q(-Z +Y)” :D=(P-R)÷(2 Abs (H-O)PR):Z=Abs((T-S)cos(G-90)－(N-W)sin(G-90))：L=0：M”M(YJJ)”=90: （注：此处若不给M赋值，则可计算斜交点）Lbl 0：Prog " SUB1 "：L=(T-Y)cos(G-90+QZ(1÷P+ZD)×180÷π)-(N-X)sin(G-90+QZ(1÷P +ZD) ×180÷π)：AbsL<1E-6=>Goto1：≠>Z=Z+L：Goto 0Δ←┘Lbl 1：L=0：Prog " SUB1 "：L=(T-Y)÷sinF:”K=”:K=O+Z◢”L=”:L=L2.正算主程序 ( ZBZS)W"X0"：S"Y0"：O"K0"：G"F0"：H"KN"：P"R0"：R"RN"：Q”Q(-Z +Y)” :D=(P-R)÷(2Abs(H-O)PR)：L”L(-Z +Y)” :M”ANG”=90:（注：此处若不给M赋值，则可计算斜交点）Z=Abs(K-O)：Prog"SUB1"：”FWJ=”:F=F-M:”X=”:X=X◢”Y=”:Y=Y3.正算子程序(SUB1)Defm4:A=0.1184634425:B=0.2393143352:Z[4]=0.2844444444:C=0.046910 0770:E=0.2307653449:Z[1]=0.5:X=W+Z(Acos(G+QCZ(1÷P+CZD)×180÷π)+Bcos(G+QEZ(1÷P+EZD)×180÷π)+Z[4]cos(G+QZ[1]Z(1÷P+Z[1]ZD)×180÷π)+Bcos(G+Q(1-E)Z(1÷P+(1-E)Z D)×180÷π)+Acos(G+Q (1-C)Z(1÷P+(1-C)ZD) ×180÷π)):Y=S+Z(Asin(G+QCZ(1÷P+CZD)×180÷π)+Bsin(G+QEZ(1÷P+EZD)×180÷π) +Z[4]sin(G+QZ[1]Z(1÷P+Z[1]ZD)×180÷π)+Bsin(G+Q(1-E)Z(1÷P+(1-E)ZD)×180÷π)+Asin(G+Q (1-C)Z(1÷P+(1-C)ZD) ×180÷π))：F=G+QZ(1÷P+ZD) ×180÷π+M：X=X+LcosF：Y=Y+LsinF4.曲线元要素数据库：DAT-01K≥O=>K＜H=> W=**:S=**:O=**:G=**:H=**:P=**:R=**:Q=**⊿⊿←┘K≥O=>K＜H=> W=**:S=**:O=**:G=**:H=**:P=**:R=**:Q=**⊿⊿←┘K≥O=>K＜H=> W=**:S=**:O=**:G=**:H=**:P=**:R=**:Q=**⊿⊿←┘K≥O=>K＜H=> W=**:S=**:O=**:G=**:H=**:P=**:R=**:Q=**⊿⊿←2、输入与显示说明（1）输入部分：X0 ？线元起点的X坐标Y0 ？线元起点的Y坐标K0 ？线元起点里程F0 ？线元起点切线方位角KN ？线元终点里程R0 ？线元起点曲率半径RN ？线元止点曲率半径Q ？线元左右偏标志(左偏Q=-1，右偏Q=1，直线段Q=0)K ？正算时所求点的里程L ？正算时所求点距中线的边距(左侧取负值，右侧取正值，在中线上取零) ANG？正算边桩时左右边桩连线与线路中线的右交角X ？反算时所求点的X坐标Y ？反算时所求点的Y坐标M ? 斜交右角线元要素数据库中K≥O=>K＜H=>中的O和H分别为该段线元起点里程和终点里程A、B、Z[4] 是Gauss-Legendre求积公式中的插值系数C 、E、Z[1] 是Gauss-Legendre求积公式中的求积节点（2）显示部分：X=×××正算时，计算得出的所求点的X坐标Y=×××正算时，计算得出的所求点的Y坐标K=×××反算时，计算得出的所求点的里程L=×××反算时，计算得出的所求点的边距。
用（VB）实现测量坐标转换系统
⽤（VB）实现测量坐标转换系统坐标转换系统（VB）东华理⼯⼤学Theory 北京54⾼斯坐标转换西安80⾼斯坐标转换系统1.0版多点处理结果核⼼源代码：'⾼斯坐标转换成⼤地坐标过程Public Sub GausReverse(a As Double, f As Double, x() As Double, y() As Double, RB() As Double, RL() As Double, k As Integer)Dim i As Integer, fxb As Double, fxbl As Double, fybl As Doublee = Sqr(2 *f - f ^ 2)C = a / Sqr(1 - e ^ 2)e2 = e / Sqr(1 - e ^ 2)beita0 = 1 - (3 / 4) * e2 ^ 2 + (45 / 64) * e2 ^ 4 - (175 / 256) * e2 ^ 6 + (11025 / 16384) * e2 ^ 8 beita2 = beita0 - 1beita4 = (15 / 32) * e2 ^ 4 - (175 / 384) * e2 ^ 6 + (3675 / 8192) * e2 ^ 8beita6 = (-35 / 96) * e2 ^ 6 + (735 / 2048) * e2 ^ 8beita8 = (315 / 1024) * e2 ^ 8For i = 1 To kB0 = x(i) / (C * beita0)Dofxb = 0fxbl = 0fybl = 0t = Tan(B0)yita = e2 * Cos(B0)n = a / Sqr(1 - e ^ 2 * (Sin(B0)) ^ 2)a2 = (1 / 2) * n * Sin(B0) * Cos(B0)a3 = (1 / 6) * n * (Cos(B0)) ^ 3 * (1 - t ^ 2 + yita ^ 2)a4 = (1 / 24) * n * Sin(B0) * (Cos(B0)) ^ 3 * (5 - t ^ 2 + 9 * yita ^ 2 + 4 * yita ^ 4)a5 = (1 / 120) * n * (Cos(B0)) ^ 5 * (5 - 18 * t ^ 2 + t ^ 4 + 14 * yita ^ 2 - 58 * yita ^ 2 * t ^ 2) a6 = (1 / 720) * n * Sin(B0) * (Cos(B0)) ^ 5 * (61 - 58 * t ^ 2 + t ^ 4)fxb = fxb + (C * beita6 + C * beita8 * (Cos(B0)) ^ 2) * (Cos(B0)) ^ 2fxb = (fxb + C * beita4) * (Cos(B0)) ^ 2fxb = (fxb + C * beita2) * Sin(B0) * Cos(B0)fxbl = a2 * l0 ^ 2 + a4 * l0 ^ 4 + a6 * l0 ^ 6fybl = a3 * l0 ^ 3 + a5 * l0 ^ 5RB(i) = (x(i) - fxb - fxbl) / (C * beita0)a1 = (a * Cos(RB(i))) / Sqr(1 - e ^ 2 * (Sin(RB(i)) ^ 2))RL(i) = (y(i) - fybl) / a1If Abs(RB(i) - B0) <= 0.0000000001 And Abs(RL(i) - l0) <= 0.0000000001 ThenRL(i) = zrl + l0Exit DoElseB0 = RB(i)l0 = RL(i)End IfLoopNext iEnd Sub'⼤地坐标B，L转换为⾼斯坐标x,y的过程Public Sub BLHGaus(RB() As Double, RL() As Double, GX() As Double, GY() As Double, a As Double, f As Double, k As Integer)Dim l0 As Double, fxb As Double, gxbl As Double, fybl As Doublebeita0 = 1 - (3 / 4) * e2 ^ 2 + (45 / 64) * e2 ^ 4 - (175 / 256) * e2 ^ 6 + (11025 / 16384) * e2 ^ 8 beita2 = beita0 - 1beita4 = (15 / 32) * e2 ^ 4 - (175 / 384) * e2 ^ 6 + (3675 / 8192) * e2 ^ 8beita6 = (-35 / 96) * e2 ^ 6 + (735 / 2048) * e2 ^ 8beita8 = (315 / 1024) * e2 ^ 8For i = 1 To kl0 = RL(i) - zrln = a / Sqr(1 - e ^ 2 * (Sin(RB(i))) ^ 2)t = Tan(RB(i))yita = e2 * Cos(RB(i))a1 = (a * Cos(RB(i))) / Sqr(1 - e ^ 2 * (Sin(RB(i)) ^ 2))a2 = (1 / 2) * n * Sin(RB(i)) * Cos(RB(i))a3 = (1 / 6) * n * (Cos(RB(i))) ^ 3 * (1 - t ^ 2 + yita ^ 2)a4 = (1 / 24) * n * Sin(RB(i)) * (Cos(RB(i))) ^ 3 * (5 - t ^ 2 + 9 * yita ^ 2 + 4 * yita ^ 4) a5 = (1 / 120) * n * (Cos(RB(i))) ^ 5 * (5 - 18 * t ^ 2 + t ^ 4 + 14 * yita ^ 2 - 58 * yita ^ 2 * t ^ 2)a6 = (1 / 720) * n * Sin(RB(i)) * (Cos(RB(i))) ^ 5 * (61 - 58 * t ^ 2 + t ^ 4)fxb = 0fxbl = 0fybl = 0fxb = fxb + (C * beita6 + C * beita8 * (Cos(RB(i))) ^ 2) * (Cos(RB(i))) ^ 2fxb = (fxb + C * beita4) * (Cos(RB(i))) ^ 2fxb = (fxb + C * beita2) * Sin(RB(i)) * Cos(RB(i))fxbl = a2 * l0 ^ 2 + a4 * l0 ^ 4 + a6 * l0 ^ 6fybl = a3 * l0 ^ 3 + a5 * l0 ^ 5GX(i) = C * beita0 * RB(i) + fxb + fxblGY(i) = a1 * l0 + fyblNext iEnd Sub'三维直⾓坐标XYZ转换成⼤地坐标BLH过程Public Sub BLHXYZ1(SX() As Double, SY() As Double, SZ() As Double, RB() As Double, RL() As Double, RH() As Double, k As Integer, a As Double, f As Double)Dim i As IntegerDim N0 As Double, H0 As Double, B0 As Double, sb As Double, Ni As Doublesb = a * Sqr(1 - e ^ 2)pi = 4 * Atn(1)For i = 1 To kRL(i) = Atn(Abs(SY(i) / SX(i)))If SY(i) > 0 And SX(i) < 0 ThenRL(i) = pi - RL(i)End IfN0 = aH0 = Sqr(SX(i) ^ 2 + SY(i) ^ 2 + SZ(i) ^ 2) - Sqr(a * sb)B0 = Atn(SZ(i) / ((Sqr(SX(i) ^ 2 + SY(i) ^ 2)) * (1 - e ^ 2 * N0 / (N0 + H0))))DoNi = a / Sqr(1 - e ^ 2 * (Sin(B0)) ^ 2)RH(i) = Sqr(SX(i) ^ 2 + SY(i) ^ 2) / Cos(B0) - NiRB(i) = Atn(SZ(i) / ((Sqr(SX(i) ^ 2 + SY(i) ^ 2)) * (1 - e ^ 2 * Ni / (Ni + RH(i)))))If Abs(RB(i) - B0) < 0.0000000001 And Abs(RH(i) - H0) < 0.0000000001 ThenExit DoElseB0 = RB(i)H0 = RH(i)End IfLoopNext iEnd Sub'最⼩⼆乘法求解七参数布尔萨模型Public Sub SloveBuersa(XD() As Double, XG() As Double, R() As Double, k As Integer) Dim a0 As Double, a1 As Double, a2 As DoubleFor i = 1 To ka0 = XG(i, 1)a1 = XG(i, 2)a2 = XG(i, 3)Call Cjuzhen(a0, a1, a2, G())For j = 1 To 3Next sNext jNext iFor i = 1 To kFor j = 1 To 3LC(3 * (i - 1) + j) = XD(i, j) - XG(i, j) Next jNext iFor i = 1 To 3 * kFor j = 1 To 7ET(j, i) = EC(i, j)Next jNext iFor i = 1 To 7For j = 1 To 7CTC(i, j) = 0For s = 1 To 3 * kCTC(i, j) = CTC(i, j) + ET(i, s) * EC(s, j) Next sNext jNext iFor i = 1 To 7For j = 1 To 7CTC1(i, j) = CTC(i, j)Next jNext iCall Comm.Reverse(CTC(), 7)For i = 1 To 7CTL(i) = 0For j = 1 To 3 * kCTL(i) = CTL(i) + ET(i, j) * LC(j)Next jNext iFor j = 1 To 7R(i) = R(i) + CTC(i, j) * CTL(j)Next jNext iEnd Sub'布尔萨模型系数矩阵⼀部分Public Sub Cjuzhen(x As Double, y As Double, z As Double, D() As Double) For i = 1 To 3D(i, i) = 1Next iD(1, 4) = xD(1, 5) = 0D(1, 6) = -zD(1, 7) = yD(2, 4) = yD(2, 5) = zD(2, 6) = 0D(2, 7) = -xD(3, 4) = zD(3, 5) = -yD(3, 6) = xD(3, 7) = 0End Sub'使⽤七参数求解新坐标系下的坐标Public Sub UseBuersa(XD() As Double, XG() As Double, EC() As Double, R() As Double, k As Integer) Dim a1 As Double, a2 As Double, a3 As Double, CR(1000) As DoubleFor i = 1 To ka1 = XG(i, 1)a2 = XG(i, 2)a3 = XG(i, 3)Call Cjuzhen(a1, a2, a3, G())For j = 1 To 3For s = 1 To 7EC(3 * (i - 1) + j, s) = G(j, s)Next iFor i = 1 To 3 * kCR(i) = 0For j = 1 To 7CR(i) = CR(i) + EC(i, j) * R(j)Next jNext iFor i = 1 To kFor j = 1 To 3XD(i, j) = XG(i, j) + CR(3 * (i - 1) + j)Next jNext iEnd Sub'弧度化为度分秒'弧度化成⾓度Public Sub RuJiao(ByVal rudu As Double, jiaodu As Double) Dim ja As Integer, jb As Integer, jc As Double pi = 4 * Atn(1)jiaodu = rudu * 180 / pija = Fix(jiaodu)jb = Fix((jiaodu - ja) * 60)jc = ((jiaodu - ja) * 60 - jb) * 60jiaodu = ja + jb / 100 + jc / 10000End Sub'矩阵求逆Public Sub Reverse(Ba, n%)Dim k%, K1%, j%, i%Dim C As Double, Aa(100, 200)For i = 1 To nFor j = 1 To nAa(i, j) = Ba(i, j)Next jNext iFor i = 1 To nAa(i, j + n) = 0End IfNext jNext iFor k = 1 To nFor j = k To nIf Aa(j, k) <> 0 Then GoTo 200Next jMsgBox "逆矩阵不存在": Exit Sub 200: For i = 1 To 2 * n C = Aa(k, i)Aa(k, i) = Aa(j, i)Aa(j, i) = CNext iC = 1 / Aa(k, k)For j = 1 To 2 * nAa(k, j) = C * Aa(k, j)Next jFor K1 = 1 To nIf K1 <> k ThenC = -Aa(K1, k)For j = 1 To 2 * nAa(K1, j) = Aa(K1, j) + C * Aa(k, j)Next jEnd IfNext K1Next kFor i = 1 To nFor j = n + 1 To 2 * nAa(i, j - n) = Aa(i, j)Next jNext iNext iEnd Sub'⾓度化成弧度Public Sub JiaoHu(ByVal jiaodu As Double, hudu As Double) Dim ja As Double, jb As Double, jc As Double pi = 4 * Atn(1)ja = Fix(jiaodu)jb = Fix((jiaodu - ja) * 100)jc = ((jiaodu - ja) * 100 - jb) * 100jiaodu = ja + jb / 60 + jc / 3600hudu = jiaodu * pi / 180End Sub。
工程测量坐标正反算通用程序（终极篇）
工程测量坐标正反算通用程序（终极篇）第五篇坐标正反算通用程序(终极篇)1. 坐标正算主程序(命名为ZBZS)第1行：Lbl 0:”K=”?K:”BIAN=”? Z:”α=”?B第2行：Prog “A”第3行：”X=”:N+Zcos(F+B)◢第4行：”Y=”:E+Zsin(F+B)◢第5行：”F=”:F?DMS◢第6行：Goto 0K——计算点的里程BIAN——计算点到中桩的距离（左负右正）α——取前右夹角为正2. 坐标反算桩号和偏距主程序(命名为ZBFS)第1行：”X1=”? C:”Y1=”?D:”K1=”?K第2行：Lbl 0:Prog “A”第3行：Pol(C-N,D-E):Icos(F-J)→S:K+S→K第4行：Abs(S)>0.0001=>Goto 0第5行：”K1=”:K◢第6行：”BIAN=”:Isin(J-F)→Z◢X1——取样点的X坐标Y1——取样点的Y坐标K1——输入时为计算起始点(在线路内即可)，输出时为反算点的桩号Z——偏距（左负右正）注：在9860或9960中需将第3行替换为Pol(C-N,D-E): List Ans[1]→I ：List Ans[2]→J：Icos(J-F)→S:K+S →K，正反算主程序所有输入赋值多加一赋值符号（→），其他所有除数据库外的程序均保持不变3. 计算坐标子程序(命名为XYF)为了简洁，本程序由数据库直接调用，上述中的正反算主程序不直接调用此程序第1行：K-A→S：(Q-P)÷L→I第2行：N+∫(cos(F+X(2P+XI)×90÷π),0,S)→N第3行：E+∫(sin(F+X(2P+XI)×90÷π),0,S)→E第4行：F+S(2P+S I)×90÷π→F第5行：F<0=>F+360→F: F>360=>F-360→F4. 数据库（命名为A）第1行：K≤175.191=>Stop（超出后显示Done）第2行：175.191→A:428513.730→N:557954.037→E:92°26′40″→F:0→P:1/ 240→Q:70.417→L:K≤A+L =>GoTo 1（第一缓和曲线）第3行：245.607→A: 428507.298→N:558024.092→E: 100°50′59.4″→F: 1/240→P:1/240→Q:72.915→L: K≤A+L =>Goto 1（圆曲线）第4行：318.522→A: 428482.988→N:558092.538→E: 118°15′25.2″→F: 1/240→P: 0→Q: 55.104→L: K≤A+L =>Goto 1（第二缓和曲线）第5行：373.627→A:428453.283→N:558138.912→E:124°50′4.5″→F:0→P:-1/180→Q:67.222→L:K≤A+L=>Goto 1:Stop（下一曲线的第一缓和曲线，示例为S型曲线，超出后显示Done）第6行：Lbl 1:Prog “XYF”A——曲线段起点的里程N——曲线段起点的x坐标E——曲线段起点的y坐标F——曲线段起点的坐标方位角P——曲线段起点的曲率(半径倒数，直线为0，左负右正)Q——曲线段终点的曲率(半径倒数，直线为0，左负右正)L——曲线段长度（尽量使用长度，为计算断链方便）说明：（1）正算主程序可以计算一般边桩的坐标，如要计算类似涵洞端墙的坐标需增加两个变量，具体方法参考本程序集中的第1篇辛普生公式的坐标计算通用程序（2）适用于任意线形：直线（0→P、0→Q）、圆曲线（圆半径倒数→P、圆半径倒数→Q）、缓和曲线（0或圆半径倒数→P、圆半径倒数或0→Q）、卵形曲线（接起点圆的半径倒数→P、接终点圆的半径倒数→Q），曲线左转多加一负号。
坐标正算、反算计算方法及在Excel中的VBA编程
坐标正算、反算计算方法及在Excel 中的VBA 编程测量中经常需要将某点相对坐标系坐标转换成线路的里程、偏距，或根据线路某一里程偏距计算出对应的相对坐标系坐标，为寻求一种快速简单高效的计算方法，本文对线路正算反算的原理进行了阐述，并结合Excel VBA 编程，将编程和Excel 的拖拽的功能相结合，编制出实用计算表，特别适用于需要大量计算边桩、围护桩的情况。
关键词：坐标方位角坐标正算坐标反算 V AB 编程循环迭代直接算法一、坐标方位角的反算1.坐标方位角反算如图1所示，已知点A 、B 的坐标，求直线AB坐标方位角α。
图1坐标方位角反算直线AB 之间的坐标增量：AB B AAB B Ax x x y y y ∆=−∆=−当0,0AB AB x y ∆>∆>时，角α位于第一象限角：arctan ABABy x α∆=∆当0,0AB AB x y ∆<∆>时，角α位于第二象限角：arctan 180AB ABy x α∆=+°∆当0,0AB AB x y ∆<∆<时，角α位于第三象限角：arctan 180AB ABy x α∆=+°∆当0,0AB AB x y ∆>∆<时，角α位于第二象限角：arctan360AB AB y x α∆=+°∆2.坐标方位角反算的VBA 编程可用VBA 将上述过程定义为一个名为angel()的函数，代码如下：Function angel(x0As Double, y0 As Double, x1 As Double, y1 As Double) As Double dx = x1- x0dy = y1- y0If dx > 0 And dy > 0 Thenangel = Atn(dy / dx)End IfIf dx < 0 And dy > 0 Thenangel = Atn(dy / dx) + 3.14159265358979End IfIf dx < 0 And dy < 0 Thenangel = Atn(dy / dx) + 3.14159265358979End IfIf dx > 0 And dy < 0 Thenangel = Atn(dy / dx) + 3.14159265358979 * 2End IfEnd Function二、直线段坐标正算与反算1.直线段正算图2直线段计算已知HZ 点坐标（x1,y1）、里程N HZ ，ZH 点坐标（x2,y2），正算时已知P 点对应的中桩里程Np 和偏距e （规定沿着线路前进方向，左边偏距为负，右边偏距为正），Np>N HZ ，求P 点对应的坐标。
曲线任意里程中边桩坐标正反算VB0函数
曲线任意里程中边桩坐标正反算(VB6.0)函数发布时间:2008-06-21 09:51:10曲线任意里程中边桩坐标正反算(VB6.0)函数(5节点法提供测试程序代码）使用说明：1. 在VA或VAB中添加一个窗体，并将其"Caption"属性改为"曲线任意里程中边桩坐标正反算(VB6.0) 函数"2. 在窗体上添加一个文本框，并将其下列属性更改为：名称 txt1MultiLine TrueScrollBars 3 Both3. 在窗体上添加三个命令按钮，并将它们的下列属性更改为：按钮一名称 Cmd1Caption 正算按钮二名称 Cmd2Caption 反算按钮三名称 Cmd3Caption 结束4. 将以下程序复制到VA或VBA的代码窗口内，点击运行命令即进行测试。
Private Const pi As Double = 3.14159265358979Private Const pi As Double = 3.14159265358979Public Function qxzs(xyb() As Double, sz() As Double, fhz() As Double)’正算函数(由里程和边距计算坐标)’入口参数线元要素xyb()及sz()为:’xyb(1)=线元起点里程 xyb(2)=线元起点X坐标 xyb(3)=线元起点Y坐标 xyb(4)=线元起点切线方位角(以弧度为单位)’xyb(5)=线元长度 xyb(6)=线元起点曲率半径 xyb(7)=线元止点曲率半径 xyb(8)=线元偏向标志’sz(1)=要计算点的中线里程 sz(2)=要计算点距中线的边距’返回值fhz()为：’fhz(1)=所求点的X坐标 fhz(2)=所求点的Y坐标 fhz(3)=所求点对应中线点向右的法线方位角Dim f0 As DoubleDim q As DoubleDim c As DoubleDim d As DoubleDim rr(5) As DoubleDim vv(5) As DoubleDim i As IntegerDim w As DoubleDim xs As DoubleDim ys As DoubleDim ff As Doublef0 = xyb(4): q = xyb(8)c = 1# / xyb(6)d = (xyb(6) - xyb(7)) / 2# / xyb(5) / xyb(6) / xyb(7)rr(1) = 0.1184634425: rr(2) = 0.2393143352rr(3) = 0.2844444444: rr(4) = rr(2): rr(5) = rr(1)vv(1) = 0.046910077: vv(2) = 0.2307653449vv(3) = 0.5: vv(4) = 1# - vv(2): vv(5) = 1# - vv(1)w = Abs(sz(1) - xyb(1))xs = 0: ys = 0For i = 1 To 5ff = f0 + q * vv(i) * w * (c + vv(i) * w * d)xs = xs + rr(i) * Cos(ff)ys = ys + rr(i) * Sin(ff)Next ifhz(3) = f0 + q * w * (c + w * d) + 0.5 * pifhz(1) = xyb(2) + w * xs + sz(2) * Cos(fhz(3))fhz(2) = xyb(3) + w * ys + sz(2) * Sin(fhz(3))End FunctionPublic Function qxfs(xyb() As Double, xpt() As Double, fhb() As Double)’反算函数(由坐标计算里程和边距)’入口参数线元要素xyb()及xpt()为:’xyb(1)=线元起点里程 xyb(2)=线元起点X坐标 xyb(3)=线元起点Y坐标 xyb(4)=线元起点切线方位角(以弧度为单位)’xyb(5)=线元长度 xyb(6)=线元起点曲率半径 xyb(7)=线元止点曲率半径 xyb(8)=线元偏向标志’xpt(1)=要计算点的X坐标 xpt(2)=要计算点的Y坐标’返回值fhb()为：’fhb(1)=所求点的中线里程 fhb(2)=所求点距中线的边距Dim f0 As DoubleDim q As DoubleDim c As DoubleDim d As DoubleDim rr(4) As DoubleDim vv(4) As DoubleDim i As IntegerDim w As DoubleDim xs As DoubleDim ys As DoubleDim ff As DoubleDim z As DoubleDim sz(2) As Doublef0 = xyb(4): q = xyb(8)c = 1# / xyb(6)d = (xyb(6) - xyb(7)) / 2# / xyb(5) / xyb(6) / xyb(7)ft = f0 - 0.5 * piw = Abs((xpt(2) - xyb(3)) * Cos(ft) - (xpt(1) - xyb(2)) * Sin(ft))z = 1’Txt1.Text = Txt1.Text + "S0=" + Str(xyb(1)) + Chr(13) + Chr(10)Do While Abs(z) > 0.000001sz(1) = xyb(1) + w: sz(2) = zCall qxzs(xyb(), sz(), fhb())ff = ft + q * w * (c + w * d)z = (xpt(2) - fhb(2)) * Cos(ff) - (xpt(1) - fhb(1)) * Sin(ff)w = w + zLoopsz(1) = xyb(1) + w: sz(2) = 0Call qxzs(xyb(), sz(), fhb())fhb(1) = xyb(1) + wfhb(2) = (xpt(2) - fhb(2)) / Sin(fhb(3))End FunctionPrivate Sub Cmd1_Click()’正算测试程序Dim qxxy(100, 8) As DoubleDim xsz(100, 3) As Double’线元要素表存入数组qxxy中，切线方位角以弧度为单位’可采用读文本文件、Excel数据表中的数据或其它方式读入数据替代以下直接赋值方式qxxy(1, 1) = 500: qxxy(1, 2) = 19942.837: qxxy(1, 3) = 28343.561: qxxy(1, 4) = 2.186466069 qxxy(1, 5) = 269.256: qxxy(1, 6) = 1E+45: qxxy(1, 7) = 1E+45: qxxy(1, 8) = 0qxxy(2, 1) = 769.256: qxxy(2, 2) = 19787.34: qxxy(2, 3) = 28563.378: qxxy(2, 4) = 2.186466069 qxxy(2, 5) = 37.492: qxxy(2, 6) = 1E+45: qxxy(2, 7) = 221.75: qxxy(2, 8) = -1qxxy(3, 1) = 806.748: qxxy(3, 2) = 19766.566: qxxy(3, 3) = 28594.574: qxxy(3, 4) = 2.101929446 qxxy(3, 5) = 112.779: qxxy(3, 6) = 221.75: qxxy(3, 7) = 221.75: qxxy(3, 8) = -1qxxy(4, 1) = 919.527: qxxy(4, 2) = 19736.072: qxxy(4, 3) = 28701.893: qxxy(4, 4) = 1.593343217 qxxy(4, 5) = 80.285: qxxy(4, 6) = 221.75: qxxy(4, 7) = 9579.228: qxxy(4, 8) = -1qxxy(5, 1) = 999.812: qxxy(5, 2) = 19744.038: qxxy(5, 3) = 28781.659: qxxy(5, 4) = 1.408141337 qxxy(5, 5) = 100#: qxxy(5, 6) = 1E+45: qxxy(5, 7) = 1E+45: qxxy(5, 8) = 0’将要计算坐标的里程桩号及距中线距离存入数组xsz中xsz(1, 1) = 700: xsz(1, 2) = -5xsz(2, 1) = 700: xsz(2, 2) = 0xsz(3, 1) = 700: xsz(3, 2) = 5xsz(4, 1) = 780: xsz(4, 2) = -5xsz(5, 1) = 780: xsz(5, 2) = 0xsz(6, 1) = 780: xsz(6, 2) = 5xsz(7, 1) = 870: xsz(7, 2) = -5xsz(8, 1) = 870: xsz(8, 2) = 0xsz(9, 1) = 870: xsz(9, 2) = 5xsz(10, 1) = 940: xsz(10, 2) = -5.123xsz(11, 1) = 940: xsz(11, 2) = 0xsz(12, 1) = 940: xsz(12, 2) = 3.009Dim i As IntegerDim j As IntegerDim k As IntegerDim ysb(8) As DoubleDim wzb(3) As DoubleDim jgb(3) As DoubleTxt1.Text = ""For i = 1 To 12For j = 1 To 5If qxxy(j, 1) <= xsz(i, 1) And xsz(i, 1) <= qxxy(j, 1) + qxxy(j, 5) ThenFor k = 1 To 8: ysb(k) = qxxy(j, k): Next kFor k = 1 To 2: wzb(k) = xsz(i, k): Next k’调用正算函数Call qxzs(ysb(), wzb(), jgb())Txt1.Text = Txt1.Text + Str(wzb(1)) + " " + Str(wzb(2)) + Chr(13) + Chr(10)For k = 1 To 3Txt1.Text = Txt1.Text + Str(jgb(k)) + Chr(13) + Chr(10)Next kTxt1.Text = Txt1.Text + Chr(13) + Chr(10)Exit ForEnd IfNext jNext iEnd SubPrivate Sub Cmd2_Click()’反算测试程序Dim qxxy(100, 8) As DoubleDim xsz(100, 3) As Double’线元要素表存入数组qxxy中，切线方位角以弧度为单位’可采用读文本文件、Excel数据表中的数据或其它方式读入数据替代以下直接赋值方式qxxy(1, 1) = 500: qxxy(1, 2) = 19942.837: qxxy(1, 3) = 28343.561: qxxy(1, 4) = 2.186466069qxxy(1, 5) = 269.256: qxxy(1, 6) = 1E+45: qxxy(1, 7) = 1E+45: qxxy(1, 8) = 0qxxy(2, 1) = 769.256: qxxy(2, 2) = 19787.34: qxxy(2, 3) = 28563.378: qxxy(2, 4) = 2.186466069 qxxy(2, 5) = 37.492: qxxy(2, 6) = 1E+45: qxxy(2, 7) = 221.75: qxxy(2, 8) = -1qxxy(3, 1) = 806.748: qxxy(3, 2) = 19766.566: qxxy(3, 3) = 28594.574: qxxy(3, 4) = 2.101929446 qxxy(3, 5) = 112.779: qxxy(3, 6) = 221.75: qxxy(3, 7) = 221.75: qxxy(3, 8) = -1qxxy(4, 1) = 919.527: qxxy(4, 2) = 19736.072: qxxy(4, 3) = 28701.893: qxxy(4, 4) = 1.593343217 qxxy(4, 5) = 80.285: qxxy(4, 6) = 221.75: qxxy(4, 7) = 9579.228: qxxy(4, 8) = -1qxxy(5, 1) = 999.812: qxxy(5, 2) = 19744.038: qxxy(5, 3) = 28781.659: qxxy(5, 4) = 1.408141337 qxxy(5, 5) = 100#: qxxy(5, 6) = 1E+45: qxxy(5, 7) = 1E+45: qxxy(5, 8) = 0’将要反算里程桩号及距中线距离的点坐标存入数组xsz中’由于没有提供判断点与线元关系的函数据，以下数据中的’第一个数为里程桩号，用于确定所求点所在的线元xsz(1, 1) = 501: xsz(1, 2) = 19831.418: xsz(1, 3) = 28509.726xsz(2, 1) = 501: xsz(2, 2) = 19827.336: xsz(2, 3) = 28506.838xsz(3, 1) = 500: xsz(3, 2) = 19823.25398: xsz(3, 3) = 28503.95084xsz(4, 1) = 770: xsz(4, 2) = 19785.25749: xsz(4, 3) = 28575.0227xsz(5, 1) = 770: xsz(5, 2) = 19781.15561: xsz(5, 3) = 28572.16358xsz(6, 1) = 770: xsz(6, 2) = 19777.05373: xsz(6, 3) = 28569.30446xsz(7, 1) = 807: xsz(7, 2) = 19747.536: xsz(7, 3) = 28654.131xsz(8, 1) = 807: xsz(8, 2) = 19742.686: xsz(8, 3) = 28652.914xsz(9, 1) = 807: xsz(9, 2) = 19737.837: xsz(9, 3) = 28651.697xsz(10, 1) = 920: xsz(10, 2) = 19741.5912: xsz(10, 3) = 28722.058xsz(11, 1) = 920: xsz(11, 2) = 19736.4769: xsz(11, 3) = 28722.3564xsz(12, 1) = 920: xsz(12, 2) = 19733.473: xsz(12, 3) = 28722.5317Dim i As IntegerDim j As IntegerDim k As IntegerDim ysb(8) As DoubleDim wzb(3) As DoubleDim jgb(3) As DoubleTxt1.Text = ""For i = 1 To 12For j = 1 To 5If qxxy(j, 1) <= xsz(i, 1) And xsz(i, 1) < qxxy(j, 1) + qxxy(j, 5) ThenFor k = 1 To 8: ysb(k) = qxxy(j, k): Next kFor k = 1 To 2: wzb(k) = xsz(i, k + 1): Next k’调用反算函数Call qxfs(ysb(), wzb(), jgb())Txt1.Text = Txt1.Text + Str(wzb(1)) + " " + Str(wzb(2)) + Chr(13) + Chr(10) For k = 1 To 3Txt1.Text = Txt1.Text + Str(jgb(k)) + Chr(13) + Chr(10)Next kTxt1.Text = Txt1.Text + Chr(13) + Chr(10)Exit ForEnd IfNext jNext iEnd SubPrivate Sub Cmd3_Click()End。
vb坐标正算程序
VB坐标正算程序简介VB坐标正算程序是一种用于计算地理坐标的计算机程序，使用VB语言编写。
本文将深入探讨VB坐标正算程序的原理、功能以及使用方法。
原理VB坐标正算程序基于数学和地理学的原理，通过输入已知的地理坐标和相关参数，计算出目标点的地理坐标。
其原理主要包括以下几个步骤：1. 坐标系统转换VB坐标正算程序支持不同的坐标系统，如经纬度坐标、UTM坐标等。
在进行计算之前，需要将输入的坐标转换为程序所使用的统一坐标系统。
2. 大地测量模型大地测量模型是VB坐标正算程序中的核心算法，用于计算地球上两点之间的距离和方位角。
常用的大地测量模型有球面模型和椭球模型，根据实际需求选择合适的模型进行计算。
3. 参数输入在进行坐标正算之前，需要输入已知的地理坐标和相关参数。
已知的地理坐标可以是已知点的经纬度或UTM坐标，相关参数包括大地测量模型的参数、椭球模型的参数等。
4. 坐标计算根据已知的地理坐标和相关参数，通过大地测量模型进行计算，得出目标点的地理坐标。
功能VB坐标正算程序具有以下主要功能：1. 坐标系统转换VB坐标正算程序可以实现不同坐标系统之间的转换，如经纬度坐标转换为UTM坐标，UTM坐标转换为经纬度坐标等。
通过这个功能，用户可以方便地在不同坐标系统之间进行转换。
2. 大地测量计算VB坐标正算程序可以根据已知的地理坐标和相关参数，通过大地测量模型计算目标点的地理坐标。
用户只需输入已知点的坐标和相关参数，程序即可自动计算出目标点的坐标。
3. 参数设置VB坐标正算程序提供了参数设置功能，用户可以根据实际需求设置大地测量模型的参数、椭球模型的参数等。
通过参数设置，用户可以根据实际需求进行精确的坐标计算。
4. 结果输出VB坐标正算程序可以将计算结果以文本形式输出，用户可以方便地查看计算结果。
输出结果包括目标点的经纬度坐标、UTM坐标等。
使用方法以下是VB坐标正算程序的使用方法：1. 安装程序首先，用户需要将VB坐标正算程序安装到计算机上。
excel坐标反算vb程序
excel坐标反算vb程序Excel坐标反算VB程序。
在Excel中，单元格通常以字母和数字的组合来表示，比如A1、B2等。
有时候我们需要将这种坐标转换为行号和列号的形式，这就是坐标反算。
下面是一个用VB程序实现Excel坐标反算的示例代码：vb.Function GetCellCoordinates(cellAddress As String) As String.Dim col As String.Dim row As String.Dim i As Integer.For i = 1 To Len(cellAddress)。
If Not IsNumeric(Mid(cellAddress, i, 1)) Then.col = col & Mid(cellAddress, i, 1)。
Else.row = Mid(cellAddress, i)。
Exit For.End If.Next i.col = Range(col & "1").Column.GetCellCoordinates = "Row: " & row & ", Column: " & col.End Function.这段代码定义了一个名为GetCellCoordinates的函数，它接受一个单元格地址作为输入，然后返回该单元格的行号和列号。
该函数首先将单元格地址拆分为列和行两部分，然后使用Range对象的Column属性将列转换为列号，最后将行号和列号拼接成字符串返回。
使用这个函数，我们可以很方便地将Excel中的单元格坐标转换为行号和列号的形式，从而方便在VB程序中进行处理。
这样的功能在处理Excel数据时非常有用，可以帮助我们快速定位和处理特定的单元格数据。
利用VB开发极坐标正反算小程序
利用VB开发极坐标正反算小程序摘要：利用VB编程中的面向对象功能，开发方便实用的工程测量小程序：极坐标正反算。
关键词：极坐标正反算、方位角、角度制、弧度制、坐标增量Abstract: using VB object oriented programming function, to facilitate the development of practical engineering surveying small program: polar coordinates is positive and negative.Keywords: polar coordinates is positive and negative, azimuth Angle, system, radian system, coordinate increment全站仪放样测量在各种基建工程中利用非常广泛，如：大楼基桩放样、桥梁桥墩放样、公路放线等等。
全站仪放样测量通常采用极坐标法。
极坐标法工程坐标的正反算，是放样准确性的基础保障。
通常极坐标法正反算是采用工程计算器计算取得，各种工程计算器的计算操作方法不尽相同，这就导致在不同的计算器使用时产生错误操作，反复的计算检核，给测绘工作带来不便。
随着便携式微型电脑的普及，野外工程测量工作中随时随地的采用电脑计算绘图成为现实，不仅方便准确，而且效率大大提高。
本文利用VB编程中的面向对象功能，开发方便实用的工程测量小程序：极坐标正反算。
接下来简单介绍一下编程过程。
首先，计算原理如图例一：图例一极坐标正算时：站点为O，前、后视点为P0、P1、P2、P3，分别在四个象限，如图例一。
其坐标方位角a0、a1、a2、a3与夹角a(a=arctg(DY/DX))的关系为：a0=a，a1=a+180°，a2=a+180°，a3=a+360°，半径与坐标增量的关系：R2=DX2+DY2。
vb课程测绘程序设计二
作业
1 角度换算程序
2 坐标方位角计算程序 3 导线测量近似坐标计算程序 4 全站仪放样元素计算程序
调用 Call recarea(10,20) recarea 10,20
5、文件操作 Open d:\dx.dat For Input As #1 打开文件
读数据 inout #1 a,b,c line input #1 a$
Open d:\dx1.dat For output As #2 打开 文件写数据
3) C点坐标计算公式: xc=xb+s*cos tbc yc=yb+s*sin tbc
4) 导线计算近似坐标,在各导线点上循环 计算.
五、全站仪放样元素计算
放样:把设计图纸上工程建筑物的平面位置和高程， 用一定的测量仪器和方法测设到实地上去的测量工作 称为施工放样(也称施工放线)。 测图工作是利用控制 点测定地面上地形特征点，缩绘到图上。施工放样则 与此相反，利用控制点，在实地上定出建筑物的特征 点，据以施工 . 公路 管线 桥梁 水电站等等都需要施工 放样.
jd4
-12
88
jd
-78.7533 -78.0755
2) 度换算度分秒 Public Function Dms( jd) [公有过程 子函数 名称(形参) ] jd1=fix(jd) jd2=(jd-jd1)*60 jd3=fix(jd2) jd4=(jd2-jd3)*60 jd=jd1+jd3/100+jd4/10000 End function
+ 字符串连接符
a$=Surveying program
Instr（） 查找子串
Left() 取左侧字符
Right() 取右侧字符
vb坐标正算程序
vb坐标正算程序
VB坐标正算程序是一种用于计算点位坐标的工具，通常用于工程测量、地理信息系统等领域。
通过输入已知点的坐标和距离、方位角等数据，程序可以准确计算出目标点的坐标。
下面将详细介绍VB 坐标正算程序的使用方法和注意事项。
打开VB坐标正算程序，通常程序界面会包括输入框和计算按钮。
在输入框中，需要输入已知点的坐标、距离和方位角等数据。
确保输入的数据准确无误，否则会影响计算结果的准确性。
接下来，点击计算按钮，程序会根据输入的数据进行计算，最终显示目标点的坐标。
在计算过程中，程序会考虑各种因素，如坐标系、单位制等，确保计算结果符合实际需求。
在使用VB坐标正算程序时，需要注意以下几点：
1. 确保输入的数据准确无误，包括坐标、距离、方位角等信息。
2. 注意选择合适的坐标系和单位制，以保证计算结果的准确性。
3. 在计算过程中，及时保存已知点和目标点的数据，方便后续查阅和使用。
4. 如遇到计算结果不符合预期的情况，及时检查输入数据和计算方法，找出错误并进行修正。
总的来说，VB坐标正算程序是一种方便快捷的工具，可以帮助工程师、测量员等专业人士准确计算点位坐标。
通过正确使用该程序，
可以提高工作效率，减少人为误差，确保测量数据的准确性和可靠性。
希望以上介绍能帮助大家更好地理解和应用VB坐标正算程序。
测量方位角计算公式VB源代码
测量方位角计算公式VB源代码角度化弧度Public Function Radian(a As Double) As DoubleDim Ra As DoubleDim c As DoubleDim FS As DoubleDim Ib As IntegerDim Ic As IntegerRa = pi / 180#Ib = Int(a)c = (a - Ib) * 100#Ic = Int(c)FS = (c - Ic) * 100#Radian = (Ib + Ic / 60# + FS / 3600#) * RaEnd Function'弧度化角度Public Function Degree(a As Double) As DoubleDim B As DoubleDim Fs1 As DoubleDim Im1 As IntegerDim Id1 As IntegerB = aCall DMS(B, Id1, Im1, Fs1)Degree = Id1 + Im1 / 100# + Fs1 / 10000#End FunctionPublic Sub DMS(a As Double, ID As Integer, IM As Integer, FS As Double) Dim B As DoubleDim c As Doublec = ac = 180# / pi * cID = Int(c + 0.0000005)B = (c - ID) * 60 + 0.0005IM = Int(B)FS = (B - IM) * 60End Sub'计算两点间的方位角Public Function azimuth(x1 As Double, y1 As Double, x2 As Double, y2 As Double) As SingleDim dx As DoubleDim dy As DoubleDim fwj As Doubledx = x2 - x1dy = y2 - y1If dy <> 0 Thenfwj = pi * (1 - Sgn(dy) / 2) - Atn(dx / dy) azimuth = Degree(fwj)ElseIf dx > 0 Thenazimuth = 0Elseazimuth = 180End IfEnd IfEnd Function5.2程序字母代表含义La—起点里程，R—圆曲线半径，l0—两端缓和曲线长，α—曲线转向角，T—切线长，L—曲线长，E0—外矢距，q—切曲差，cc—线路转向（cc=1时，线路向右转；cc=-1时，线路向左转）,d―桩距，m―边桩距，Li―i点的里程，ZH―直缓点，HY―缓圆点，JD―交点，QZ―曲中点，YZ―圆直点，YH―圆缓点，HZ―缓直点，LJD—交点里程，LZH―直缓点里程，LHY―缓圆点里程，LQZ―曲中点里程，LYH―圆缓点里程，LHZ―缓直点里程。
vb坐标正算程序
vb坐标正算程序
VB坐标正算程序是一种非常实用的工具，它可以帮助我们快速计算出某个点的坐标。
在实际工作中，我们经常需要用到这种工具，比如在地图制作、测量、建筑设计等领域。
VB坐标正算程序的实现原理是利用数学公式来计算出目标点的坐标。
具体来说，我们需要知道已知点的坐标、距离和方位角，然后根据三角函数公式来计算出目标点的坐标。
这个过程需要用到VB 语言的数学函数和逻辑运算符，因此需要一定的编程基础。
在编写VB坐标正算程序时，我们需要注意以下几点：
1. 确定计算公式：根据已知点的坐标、距离和方位角，确定计算目标点坐标的公式。
这个公式需要考虑到坐标系的不同，比如笛卡尔坐标系和极坐标系的计算公式是不同的。
2. 输入数据的格式：在编写程序时，需要考虑输入数据的格式，比如坐标的单位、距离的单位、方位角的单位等。
这些单位需要在程序中进行转换，以保证计算的准确性。
3. 界面设计：为了方便用户使用，我们需要设计一个简洁明了的界面，让用户能够方便地输入数据和查看计算结果。
界面设计需要考虑到用户的使用习惯和操作流程，以提高用户的体验。
4. 错误处理：在编写程序时，需要考虑到可能出现的错误情况，比
如输入数据错误、计算公式错误等。
我们需要在程序中加入相应的错误处理机制，以避免程序崩溃或计算结果错误。
VB坐标正算程序是一种非常实用的工具，它可以帮助我们快速计算出目标点的坐标。
在编写程序时，我们需要考虑到计算公式、输入数据的格式、界面设计和错误处理等方面，以保证程序的准确性和易用性。
常用的的测量程序vb代码
取一元、二元、五元的硬币共十枚，付给25元钱，有多少种不同的取法?方法一Private Sub Command1_Click()Print "一元", "两元", "五元"For a = 0 To 10For b = 0 To 10For c = 0 To 10If a + 2 * b + 5 * c = 25 And a + b + c = 10 ThenPrint a, b, cEnd IfNext cNext bNext aEnd Sub：方法二Private Sub Command1_Click()Print "一元", "两元", "五元"For a = 0 To 10For b = 0 To 10c = 10 - a - bIf a + 2 * b + 5 * c = 25 And c > 0 ThenPrint a, b, cEnd IfNext bNext aEnd Sub九九乘法表方法一Private Sub Command1_Click() Print Tab(12); "九九乘法表" For i = 1 To 9For j = 1 To iPrint i * j;Next jPrintNext iEnd Sub方法二Private Sub Command2_Click() ShowFontSize = 15Print Tab(12);FontSize = 12PrintFor k = 0 To 9Print Tab(k * 4); k;Next kjiuPrintFor j = 1 To 9Print j;For k = 1 To jPrint Tab(k * 4); j * k;Next kPrintNext jEnd Sub求T = 8! = 1×2×3×…×8 Private Sub Command1_Click()jc = 1n = Val(Text1.Text)For c = 1 To njc = jc * cNext cPrint "jc="; jcEnd Sub用100 元买100 只鸡，母鸡3元1只，小鸡1元3只，问各应买多少只?Private Sub Command1_Click()Dim x As Integer, y As IntegerFor x = 1 To 30y = 100 - xIf 3 * x + y / 3 = 100 ThenPrint "母鸡只数为:"; x,Print "小鸡只数为:"; yEnd IfNext xEnd Sub数组打印数组的上界和下界数值Private Sub Command1_Click() Dim a(1 To 10) As IntegerPrint "下界值", "上界值" Print LBound(a), UBound(a) End Sub数组解决1+2+3+4+5+6+7+8=？Private Sub Command1_Click() Dim a(1 To 10) As IntegerDim sum As IntegerFor b = 1 To 8a(b) = bsum = sum + a(b)Next bText1.Text = sumPrint "1+2+3+4+5+6+7+8=" & sum End Sub任意五个数字之和Private Sub Command1_Click()Dim Data(5) As IntegerDim Sum, I As IntegerFor I = 1 To 5Data(I) = InputBox("输入第" & I & "个数据") Next IFor I = 1 To 5Sum = Sum + Data(I)Next IText1.Text = SumPrint SumEnd Sub连续输入5个数字例如1，2，3，4，51+3+5+7+9=？奇数和Private Sub Command1_Click()Dim a(1 To 5) As IntegerDim sum As IntegerFor x = 1 To 5a(x) = x * 2 - 1sum = sum + a(x)Next xText1.Text = sumPrint sumEnd SubPrivate Function pf(x As Long, y As Long) As Long s = Sqr(x ^ 2 + y ^ 2)pf = sEnd FunctionPrivate Sub Command1_Click()Dim a As LongDim b As LongDim c As Longa = Val(Text1.Text)b = Val(Text2.Text)s = pf(a, b)Print sEnd SubSub过程和Function过程3. 编写过程，求两个数的最大公约数。
VB报告(坐标正反算使用说明)
一、输入界面1.单击VB中的“运行”快捷键，弹出图1所示的运行界面图12.在图1中选择按钮，进入坐标正算模式，如图2图2在图2中输入已知点坐标、已知点至未知点的边长和坐标方位角、保留的小数位数，点名可不输入，输入完后，选择“计算”按钮。
如要计算多个点坐标，则计算完一个点后用鼠标单击“刷新”按钮，重复以上操作即可。
若想退出坐标正算功能，用鼠标左键单击“退出”按钮，在弹出的提示框中选择“是”，如图3图33. 在图1中选择按钮，进入坐标反算模式，如图4图4在图4中输入两个已知点坐标、保留的小数位数，点名可不输入，输入完后，选择“计算”按钮。
如要计算多个点坐标，则计算完一个点后用鼠标单击“刷新”按钮，重复以上操作即可。
若想退出坐标反算功能，用鼠标左键单击“退出”按钮，在弹出的提示框中选择“是”，如图3二、输入，输出数据表格中的方位角以小数的形式输入，例如“321°18′56″“的输入格式为321.1856，若度数为321°18′56.5″的输入格式为321.18565，坐标的保留位数保留三位，别的以此类推方位角以小数的形式输入，例如“164°02′02″”的输入格式为164.0202，若度数为164°02′02.5″的输入格式为164.02025，表格中的方位角的小数保留位数为0位三、源代码Private Sub Command1_Click()If Option1.Value = True And Option2.Value = False Thenzhengsuan '当选择坐标正算按钮时调用坐标正算程序End IfIf Option1.Value = False And Option2.Value = True Thenfansuan '当选择坐标反算按钮时调用坐标反算程序End IfEnd Sub'坐标正算程序Private Sub zhengsuan()Dim s As DoubleDim a As DoubleDim x As DoubleDim y As DoubleDim m As DoubleDim n As DoubleDim degree As DoubleDim minute As DoubleDim second As DoubleDim rad As DoubleDim bbt As IntegerDim result As DoubleDim p As Doubles = Val(Text5.Text)a = Val(Text6.Text)Rad_do a, degree, minute, second, rad '调用将度分秒转化为弧度的程序x = Val(Text2.Text) + s * Cos(rad)y = Val(Text3.Text) + s * Sin(rad)p = Fix(x)x = x - pbbt = Val(Text4.Text)Sheru m, n, bbt, x, result '调用奇进偶舍程序Label12.Caption = result + pp = Fix(y)y = y - pSheru m, n, bbt, y, result '调用奇进偶舍程序Label13.Caption = result + pEnd Sub'坐标反算程序Private Sub fansuan()Dim s As DoubleDim x As DoubleDim y As DoubleDim sing As DoubleDim m As DoubleDim n As DoubleDim f As DoubleDim result As DoubleDim bbt As IntegerDim degree As DoubleDim minute As DoubleDim second As DoubleDim rad As DoubleDim p As Doublex = Val(Text5.Text)y = Val(Text6.Text)m = y - Val(Text3.Text)n = x - Val(Text2.Text)If n <> 0 Thenm = m / nrad = Atn(m)sing = Sgn(rad)End Ifdegree_m_s degree, minute, second, rad '调用将弧度转化为度分秒的程序bbt = Val(Text8.Text)m = second * 10 ^ bbtp = Fix(second)second = second - pSheru m, n, bbt, second, result '调用奇进偶舍程序second = result + pfangweijiao degree, minute, second, (x - Val(Text2.Text)), (y - Val(Text3.Text)), sing '调用计算坐标方位角的程序zhuanhua minute, second, degreesecond = second * 10 ^ bbtLabel13.Caption = degree & "." & minute & secondIf minute < 10 ThenLabel13.Caption = degree & "." & "0" & minute & secondEnd IfIf second < 10 ^ (bbt + 1) ThenLabel13.Caption = degree & "." & minute & "0" & secondEnd IfIf minute < 10 And second < 10 ^ (bbt + 1) ThenLabel13.Caption = degree & "." & "0" & minute & "0" & secondEnd If'计算边长Ss = (y - Val(Text3.Text)) ^ 2 + (x - Val(Text2.Text)) ^ 2s = Sqr(s)bbt = Val(Text4.Text)p = Fix(s)s = s - pSheru m, n, bbt, s, result '调用奇进偶舍程序Label12.Caption = result + pEnd Sub'将度分秒化为弧度Private Sub Rad_do(ByVal a As Double, ByVal degree As Double, ByVal minute As Double, ByVal second As Double, ByRef rad As Double)degree = a \ 1a = a - Fix(a)minute = Fix(a * 100)second = (a * 100 - minute) * 100rad = (3600 * degree + 60 * minute + second) / 206264.8063End Sub'将弧度转化为度分秒的程序Private Sub degree_m_s(ByRef degree As Double, ByRef minute As Double, ByRef second As Double, ByRef rad As Double)rad = rad * 180 / 3.1415926535degree = rad \ 1rad = (rad - degree) * 60minute = rad \ 1second = (rad - minute) * 60End Sub'奇进偶舍程序Private Sub Sheru(ByVal m As Double, ByVal n As Double, ByVal bbt As Double, ByVal x As Double, ByRef result As Double)m = x * 10 ^ bbtn = m - m \ 1If n < 0.5 Thenresult = (m \ 1) / 10 ^ bbtElseIf n > 0.5 Thenresult = (m \ 1 + 1) / 10 ^ bbtElseIf (m \ 1) Mod 2 Thenresult = (m \ 1 + 1) / 10 ^ bbtElseresult = (m \ 1) / 10 ^ bbtEnd IfEnd IfEnd Sub'计算坐标方位角的程序Private Sub fangweijiao(ByRef degree As Double, ByRef minute As Double, ByRef second As Double, ByVal m, ByVal n As Double, ByVal sing As Integer)Dim i As IntegerIf sing = 1 ThenIf n < 0 And m < 0 Thendegree = degree + 180End IfElseIf sing = -1 ThenIf n > 0 And m < 0 Thendegree = degree + 179minute = minute + 59second = second + 60ElseIf n < 0 And m > 0 Thendegree = degree + 359minute = minute + 59second = second + 60End IfEnd Ifi = Sgn(n)If m <> 0 ThenIf m < 0 And n = 0 Thendegree = "180"ElseIf m > 0 And n = 0 Thendegree = "0"End IfElseIf i = 1 Thendegree = "90"ElseIf i = -1 Thendegree = "270"ElseMsgBox "您输入了两个相同的点，请重新输入！"End IfEnd IfEnd Sub'当分秒超过60时须向上一级进位及方位角度数超过360°须减360°的程序Private Sub zhuanhua(ByRef minute As Double, ByRef second As Double, ByRef degree As Double)If second >= 60 Thenminute = minute + 1second = second - 60ElseIf second < 0 Thenminute = minute - 1second = second + 60End IfIf minute >= 60 Thendegree = degree + 1minute = minute - 60ElseIf minute < 0 Thendegree = degree - 1minute = minute + 60End IfIf degree >= 360 Thendegree = degree - 360End IfEnd Sub'退出程序Private Sub Command3_Click()If MsgBox("是否退出？", vbYesNo, "提示") = vbYes ThenUnload MeEnd IfEnd Sub'刷新程序Private Sub Command4_Click()Text2.Text = ""Text3.Text = ""Text4.Text = 3Text5.Text = ""Text6.Text = ""Text8.Text = 1Label12.Caption = ""Label13.Caption = ""End Sub'设置窗体的大小，使窗体充满整个屏幕并对label6和label7赋值Private Sub Form_Load()Me.Height = Screen.HeightMe.Width = Screen.WidthMe.Left = 0Me.Top = 0Label6.Caption = "边长（S）"Label7.Caption = "方位角（a）"Label17.Caption = "陈亮编程"Label18.Caption = " 2011.09.05"End Sub'设置坐标正算时Label6.Caption和Label7.Caption的值及设计小数点位数Private Sub Option1_Click()If Option1.Value = True And Option2.Value = False ThenLabel14.Caption = Text1.Text & "—>未知点" & Text7.TextLabel6.Caption = "边长（S）"Label7.Caption = "方位角（a）"Label10.Caption = "X"Label11.Caption = "Y"Text4.Text = 3Text8.Text = 1End IfEnd Sub''设置坐标反算时Label0.Caption和Label1.Caption的值及设计小数点位数Private Sub Option2_Click()If Option1.Value = False And Option2.Value = True ThenLabel6.Caption = "X"Label7.Caption = "Y"Label14.Caption = ""Label10.Caption = "边长（S）"Label11.Caption = "方位角（a）"Text4.Text = 3Text8.Text = 1End IfEnd Sub。
高斯消去法 矩阵运算 坐标正反算等vb程序设计
高斯消去法Private Sub Command1_Click()Dim a(1 To 10, 1 To 11) As DoubleDim x(1 To 10) As DoubleDim Sum As DoubleDim n As IntegerDim i As IntegerDim j As IntegerDim k As Integern = Val(InputBox("输入未知量个数(最多10个)")) For i = 1 To nFor j = 1 To n + 1a(i, j) = Val(InputBox("输入增广矩阵")) Next jNext iFor i = 1 To nFor j = 1 To n + 1Print a(i, j);Next jPrintNext iRem 消元过程For k = 1 To n - 1For i = k + 1 To nFor j = k + 1 To n + 1a(i, j) = a(i, j) - a(i, k) * a(k, j) / a(k, k) Next jNext iNext kRem 回代过程x(n) = a(n, n + 1) / a(n, n)Print "x"; n; "="; x(k);PrintFor k = n - 1 To 1 Step -1Sum = 0For j = k + 1 To nSum = a(k, j) * X(j) + SumNext jx(k) = (a(k, n + 1) - Sum) / a(k, k)Print "x"; k; "="; x(k);PrintNext kEnd Sub'将度.分秒形式化为弧度：输入为度.分秒形式，输出为弧度Public Function DoToHu(ByVal DoFenMiao As Double) As Single Dim du%, fen%, miao%, angle#du = Fix(DoFenMiao)DoFenMiao = (DoFenMiao - du) * 100fen = Fix(DoFenMiao)miao = (DoFenMiao - fen) * 100angle = du + fen / 60 + miao / 3600DoToHu = angle * PI / 180End Function'弧度化为度.分秒的形式：输入弧度值，输出度.分秒（各占两位）Public Function HuToDo(ByVal Hu As Double) As SingleDim du%, fen%, miao%Hu = Hu * 180 / PIdu = Fix(Hu)Hu = (Hu - du) * 60fen = Fix(Hu)Hu = (Hu - fen) * 60miao = Fix(Hu + 0.5)If miao = 60 Thenfen = fen + 1miao = 0End IfIf fen = 60 Thendu = du + 1fen = 0End IfHuToDo = du + fen / 100 + miao / 10000End Function矩阵运算Dim a() As LongDim b() As LongDim c() As LongDim m As LongDim n As LongDim p As LongDim q As LongPrivate Sub Command1_Click()On Error GoTo lab:m = InputBox("请输入A矩阵行数", "提示")n = InputBox("请输入A矩阵列数", "提示")Picture1.ClsPicture3.ClsReDim a(1 To m, 1 To n) As LongFor i = 1 To mFor j = 1 To na(i, j) = InputBox("请输入矩阵a(" & i & "," & j & ")数值", "提示") Picture1.Print a(i, j);Next jPicture1.PrintNext ilab:End SubPrivate Sub Command10_Click()EndEnd SubPrivate Sub Command2_Click()On Error GoTo lab:p = InputBox("请输入B矩阵行数", "提示")q = InputBox("请输入B矩阵列数", "提示")Picture2.ClsPicture3.ClsReDim b(1 To p, 1 To q) As LongFor i = 1 To pFor j = 1 To qb(i, j) = InputBox("请输入矩阵b(" & i & "," & j & ")数值", "提示") Picture2.Print b(i, j);Next jPicture2.PrintNext ilab:End SubPrivate Sub Command3_Click()On Error GoTo lab:Picture3.ClsIf m = 0 Or n = 0 Or p = 0 Or q = 0 ThenMsgBox "请先输入矩阵", vbOKOnly, "提示"End IfIf m <> p Or n <> q ThenMsgBox "请输入行数和列数相同的矩阵才可相加", vbOKOnly, "提示" End IfIf m = p And n = q ThenLabel1.Caption = "+"ReDim c(1 To m, 1 To n) As LongFor i = 1 To mFor j = 1 To nc(i, j) = a(i, j) + b(i, j)Picture3.Print c(i, j);Next jPicture3.PrintNext iEnd Iflab:End SubPrivate Sub Command4_Click()On Error GoTo lab:Picture3.ClsIf m = 0 Or n = 0 Or p = 0 Or q = 0 ThenMsgBox "请先输入矩阵", vbOKOnly, "提示"End IfIf m <> p Or n <> q ThenMsgBox "请输入行数和列数相同的矩阵才可相减", vbOKOnly, "提示" End IfIf m = p And n = q ThenLabel1.Caption = "-"ReDim c(1 To m, 1 To n) As LongFor i = 1 To mFor j = 1 To nc(i, j) = a(i, j) - b(i, j)Picture3.Print c(i, j);Next jPicture3.PrintNext iEnd Iflab:End SubPrivate Sub Command5_Click()On Error GoTo lab:Picture3.ClsIf m = 0 Or n = 0 Or p = 0 Or q = 0 ThenMsgBox "请先输入矩阵", vbOKOnly, "提示"End IfIf n <> p ThenMsgBox "请输入A矩阵列数和B矩阵行数相等的矩阵再做乘积", vbOKOnly, "提示" End IfIf n = p ThenLabel1.Caption = "x"ReDim c(1 To m, 1 To q) As LongFor i = 1 To mFor j = 1 To qFor k = 1 To nc(i, j) = c(i, j) + a(i, k) * b(k, j)Next kPicture3.Print c(i, j);Next jPicture3.PrintNext iEnd Iflab:End Sub逆矩阵ReDim a(1 To n, 1 To n * 2)ReDim x(1 To n)For i = 1 To nFor j = 1 To n * 2a(i, j) = Val(InputBox("输入增广矩阵第" & i & "行第" & j & "列元素"))Picture1.Print a(i, j);Next jPicture1.PrintNext iFor k = 1 To n - 1 '消元For i = k + 1 To nFor j = k + 1 To n * 2a(i, j) = a(i, j) - a(i, k) * a(k, j) / a(k, k) Next jNext iNext kFor j = n + 1 To 2 * na(n, j) = a(n, j) / a(n, n)Next jFor k = n To 1 Step -1 '反消元For i = k - 1 To 1 Step -1For j = k + 1 To n * 2a(i, j) = (a(i, j) - a(i, k) * a(k, j)) / a(i, i) Next jNext iNext kFor i = 1 To nFor j = n + 1 To 2 * nPicture2.Print a(i, j); Space(3);Next jPicture2.PrintNext ilab:End Sub坐标正反算Private Sub Command1_Click()XX = Val(Text3.Text) - Val(Text1.Text)YY = Val(Text4.Text) - Val(Text2.Text)If XX = 0 And YY = 0 ThenMsgBox ("A与B点不能为同一点，请重新输入") Text1.Text = ""Text2.Text = ""Text3.Text = ""Text4.Text = ""ElseIf YY = 0 And XX > 0 ThenText5.Text = "00"Text6.Text = "00"Text7.Text = "00"ElseIf XX = 0 And YY > 0 ThenText5.Text = 90Text6.Text = "00"Text7.Text = "00"ElseIf XX < 0 And YY = 0 ThenText5.Text = 180Text6.Text = "00"Text7.Text = "00"ElseIf XX = 0 And YY < 0 ThenText5.Text = 270Text6.Text = "00"Text7.Text = "00"Elsek = Abs(YY / XX)R = Atn(k) * 180 / 3.1415926If XX > 0 And YY > 0 Thena = RElseIf XX < 0 And YY > 0 Thena = 180 - RElseIf XX < 0 And YY < 0 Thena = 180 + RElseIf XX > 0 And YY < 0 Then ‘AB在第四象限a = 360 – REnd Ifb = Format(a, "0.00000") ‘取小数后5位Text5.Text = Fix(b) ‘求度数c = Fix((b - Text5.Text) * 60)Text6.Text = c ‘求分d = Round(((b - Text5.Text) * 60 - c) * 60)Text7.Text = d ‘求秒End IfEnd SubMatlabX=[107563.8100,107620.9521,109989.2770,111411.7664,109584.1244,109506.4700];Y=[571684.5200,568999.8520,568164.3993,569885.3537,572397.4802,570099.6000];a=[0,1,0,0,1,1;1,0,1,0,0,1;0,1,0,1,0,1;0,0,1,0,1,1;1,0,0,1,0,1;1,1,1,1,1,0][m,n]=size(a)plot(Y(1),X(1),'r^',Y(2),X(2),'bo',Y(3),X(3),'bo',Y(4),X(4),'bo',Y(5),X(6),'bo',Y(6),X(6),'r^') hold onfor i=1:mfor j =1:nif a(i,j)==1line([Y(i),Y(j)],[X(i),X(j)])hold onendendendtext(Y(1),X(1),'AA')text(Y(2),X(2),'11')text(Y(3),X(3),'22')text(Y(4),X(4),'33')text(Y(5),X(6),'44')text(Y(6),X(5),'BB')grid。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
坐标正反算vb测量程序
河北工程大学测绘1001 刘长君
以下是登陆界面和计算界面的截图：
以下就是对应的代码：
《登陆界面的代码》
Private Sub Command1_Click()
If = "刘长君" And = "0" Then
Unload Me
Else
Dim a As Integer
a = MsgBox("密码输入有误，请重新输入", 1, "提示框")
If a = 1 Then
= ""
End If
End If
End Sub
Private Sub Command2_Click()
End
End Sub
《计算界面的代码》
Private Sub Command1_Click(Index As Integer)
Dim a1%, a2%, a3%, a4!, a5!, pi!
Const conpi =
If IsNumeric(Text1(1)) = False Or IsNumeric(Text2(2)) = False Or IsNumeric(Text3(3)) = False Or IsNumeric(Text4(4)) = False Or IsNumeric(Text5(5)) = False Or IsNumeric(Text6(6)) = False Then
MsgBox "输入有误"
Text1(1).SetFocus
Else
If Val(Trim(Text5(5).Text)) > 60 Or Val(Trim(Text5(5).Text)) < 0 Or Val(Trim(Text6(6).Text)) > 60 Or Val(Trim(Text6(6).Text)) < 0 Then MsgBox "方位角输入有误，请重新输入"
Text4(4).SetFocus
Text4(4).Text = ""
Text5(5).Text = ""
Text6(6).Text = ""
End If
a1 = Val(Text4(4).Text)
a2 = Val(Text5(5).Text)
a3 = Val(Text6(6).Text)
a4 = a1 + a2 / 60 + a3 / 3600
a5 = a4 * conpi / 180
= Val(Text3(3).Text) * Cos(a5)
= Val(Text3(3).Text) * Sin(a5)
= Val(Text1(1).Text) + Val
= Val(Text2(2).Text) + Val
= Format((Val * 10000 + / 10000, "####.0000")
= Format((Val * 10000 + / 10000, "####.0000")
= Format((Val * 10000 + / 10000, "####.0000")
= Format((Val * 10000 + / 10000, "####.0000")
End If
End Sub
Private Sub Command2_Click(Index As Integer)
Text1(1).Text = " "
Text2(2).Text = " "
Text3(3).Text = " "
Text4(4).Text = " "
Text5(5).Text = " "
Text6(6).Text = " "
= ""
= ""
= ""
= ""
Text1(1).SetFocus
End Sub
Private Sub Command3_Click()
Dim dx!, dy!, a12!, r12!, d12!
Const conpi =
If IsNumeric(Text7) = False Or IsNumeric(Text8) = False Or IsNumeric(Text9) = False Or IsNumeric(Text10) = False Then
MsgBox "输入有误"
Else
dx = Val - Val
dy = Val - Val
d12 = Sqr(dx ^ 2 + dy ^ 2)
= Format((d12 * 10000 + / 10000, "####.0000")
If dx = 0 And dy > 0 Then
= 90: = 0: = 0
ElseIf dx = 0 And dy < 0 Then
= 270: = 0: = 0
Else
r12 = Atn(Abs(dy / dx))
If dx > 0 And dy > 0 Then
a12 = r12
ElseIf dx < 0 And dy > 0 Then
a12 = pi - r12
ElseIf dx < 0 And dy < 0 Then
a12 = pi + r12
ElseIf dx > 0 And dy < 0 Then
a12 = 2 * pi - r12
End If
a12 = a12 / conpi * 180
= Fix(a12)
= Abs(Fix((a12 - Fix(a12)) * 60))
= Abs(Fix((((a12 - Fix(a12)) * 60) - Fix((a12 - Fix(a12)) * 60)) * 60))
End If
End If
End Sub
Private Sub Command4_Click() = ""
= ""
= ""
= ""
= ""
= ""
= ""
= ""
End Sub
Private Sub Timer1_Timer() = + 20
If = 12300 Then
= 0
End If
End Sub。