vb或MATLAB编写摄影测量前方交会-后方交会，可打支付宝

先后方交会求外方位元素

Private Sub Command1_Click()

   Dim x(4) As Double, y(4) As Double

   Dim a(8, 6) As Double

   Dim Xd(4) As Double, Yd(4) As Double, Zd(4) As Double

   Dim n As Integer, i As Integer

   Dim Xy(4) As Double, Yy(4) As Double, x_x(4) As Double, y_y(4) As Double, z_z(4) As Double

   Dim Zs0 As Double, Xs0 As Double, Ys0 As Double, ψ As Double, ω As Double, κ As Double, f As Double, dx(6, 1) As Double

   Dim L(8, 1) As Double

   Dim a1 As Double, a2 As Double, a3 As Double, b1 As Double, b2 As Double, b3 As Double, c1 As Double, c2 As Double, c3 As Double

       Dim v As Variant

   ψ = 0

   ω = 0

   κ = 0

   n = 0

   f = 153.24

   Xy(1) = Text5: Xy(2) = Text7: Xy(3) = Text9: Xy(4) = Text11

   Yy(1) = Text6: Yy(2) = Text8: Yy(3) = Text10: Yy(4) = Text12

   Xd(1) = Text13: Xd(2) = Text16: Xd(3) = Text19: Xd(4) = Text22

   Yd(1) = Text14: Yd(2) = Text17: Yd(3) = Text20: Yd(4) = Text23

   Zd(1) = Text15: Zd(2) = Text18: Zd(3) = Text21: Zd(4) = Text24

   Zs0 = 2000

   Xs0 = (Xd(1) + Xd(2) + Xd(3) + Xd(4)) / 4

   Ys0 = (Yd(1) + Yd(2) + Yd(3) + Yd(4)) / 4

   Do

   a1 = Cos(ψ) * Cos(κ) - Sin(ψ) * Sin(ω) * Sin(κ)

   a2 = -Cos(ψ) * Sin(κ) - Sin(ψ) * Sin(ω) * Cos(κ)

   a3 = -Sin(ψ) * Cos(ω)

   b1 = Cos(ω) * Sin(κ)

   b2 = Cos(ω) * Cos(κ)

   b3 = -Sin(ω)

   c1 = Sin(ψ) * Cos(κ) + Cos(ψ) * Sin(ω) * Sin(κ)

   c2 = -Sin(ψ) * Sin(κ) + Cos(ψ) * Sin(ω) * Cos(κ)

   c3 = Cos(ω) * Cos(ψ)

   For i = 1 To 4

     x_x(i) = a1 * (Xd(i) - Xs0) + b1 * (Yd(i) - Ys0) + c1 * (Zd(i) - Zs0)

     y_y(i) = a2 * (Xd(i) - Xs0) + b2 * (Yd(i) - Ys0) + c2 * (Zd(i) - Zs0)

     z_z(i) = a3 * (Xd(i) - Xs0) + b3 * (Yd(i) - Ys0) + c3 * (Zd(i) - Zs0)

     x(i) = -f * x_x(i) / z_z(i)

     y(i) = -f * y_y(i) / z_z(i)

     L(2 * i - 1, 1) = Xy(i) - x(i)

     L(2 * i, 1) = Yy(i) - y(i)

     a(2 * i - 1, 1) = (a1 * f + a3 * Xy(i)) / z_z(i)

     a(2 * i - 1, 2) = (b1 * f + b3 * Xy(i)) / z_z(i)

     a(2 * i - 1, 3) = (c1 * f + c3 * Xy(i)) / z_z(i)

     a(2 * i - 1, 4) = Yy(i) * Sin(ω) - ((Xy(i) / f) * (Xy(i) * Cos(κ) - Yy(i) * Sin(κ)) 衫消+ f * Cos(κ)) * Cos(ω)

     a(2 * i - 1, 5) = -f * Sin(κ) - (Xy(i) / f) * (Xy(i) * Sin(κ) + Yy(i) * Cos(κ))

     a(2 * 扰历i - 1, 6) = Yy(i)

     a(2 * i, 1) = (a2 * f + a3 * Yy(i)) / z_z(i)

     a(2 * i, 2) = (b2 * f + b3 * Yy(i)) / z_z(i)

     a(2 * i, 3) = (c2 * f + c3 * Yy(i)) / z_z(i)

     a(2 * i, 4) = -Xy(i) * Sin(ω) - ((Yy(i) / f) * (Xy(i) * Cos(κ) - Yy(i) * Sin(κ)) - f * Sin(κ)) * Cos(ω)

     a(2 * i, 5) = -f * 或李知Cos(κ) - Yy(i) / f * (Xy(i) * Sin(κ) + Yy(i) * Cos(κ))

     a(2 * i, 6) = -Xy(i)

   Next i

Call EquationResult(a, L, dx)

  ψ = ψ + dx(4, 1): ω = ω + dx(5, 1): κ = κ + dx(6, 1)

  Xs0 = Xs0 + dx(1, 1): Ys0 = Ys0 + dx(2, 1): Zs0 = Zs0 + dx(3, 1)

  Text25 = Xs0: Text26 = Ys0: Text27 = Zs0

  n = n + 1

Loop While Abs(dx(4, 1)) > 0.00003 Or Abs(dx(5, 1)) > 0.00003 Or Abs(dx(6, 1)) > 0.00003 Or Abs(dx(1, 1)) > 0.001 Or Abs(dx(2, 1)) > 0.001 Or Abs(dx(3, 1)) > 0.001

MsgBox "迭代次数为" & n & "次"

End Sub

在前方交会求待定点的坐标

Image1.Picture = LoadPicture(App.Path &"\厅耐bmp\" &a)

中包含二个对早兆象陆伏租：Image1和a

1、Image1这个对象是否存在

2、在程序根目录中是否有bmp目录，bmp目录中是否有a的这个图片文件，并且这个图片文件是否是Image1支持的图片格式？

2014-0715 程序已经改好，所有代码重新写，并且加了注释

并且发回到你的邮箱！请查收！

1、支持打开文件夹方式批量添加图片，用了一个模块 'VB 不支持PNG图片没办法

2、支持模糊查询

3、每次录入标题和描述都要点一下“保存”按钮才可以

4、文件每次保存都会自动copy到根目录的picture文件夹内（但是调用时没调用这个目录，不知道你是不是需要调用，如果是也很简单）

5、去除list1控件使用file1控件。

6、没有对图片的宽、高度加以限制，你可以自己限制图片的尺寸和picture1一样大小，但是图片容易失真，也可以自适应（不会的话我给你改，由于时间限制我暂时没改，下午事太多了）

7、txt文件的读写，字符串的查找功能

总之花了半小时的时间，满足你所需的功能。有啥问题在找我，记得知道给我分哦。

BY h8081234 0715

邮箱：290903456@qq.com

---