找回密码
 立即注册
搜索
热搜: rtk 全站仪 航测
查看: 1072|回复: 4

[求助]Wenjian_Cao

[复制链接]

主题

0

回帖

2

积分

新手上路

积分
2
发表于 2004-5-21 09:23:21 | 显示全部楼层 |阅读模式
本人在编程序过程中遇到困难,急求  Wenjian_Cao老师给以帮助,十分感激!
        
            多面函数拟合:ε=∑KQ(x,y,Xj,Yj)
      其中Q(x,y,Xj,Yj)= Sqr[(Xi - Xj) ^ 2 + (Yi - Yj) ^ 2]   
思路:先输入数组S(X,Y)    {已知的水准高程},求出Qnn
          再输入待求高程的X,Y坐标 ,求出Qk(Xk,Yk)=Sqr((Xk - Xj) ^ 2 + (Yk - Yj) ^ 2)
            调用求逆阵程序求Qnn的逆
            调矩阵相乘过程求Qk*Qnn^(-1)
            计算   εk= Qk*Qnn^(-1)ε
            得到正常高h=H-εk   (H为大地高)
程序初稿:Dim Qk() As Integer
Dim B() As Integer
Rect() as integer

'  n =Val(InputBox("请输入数组维数n"))


  
  Call sub1
  
   
  Xk = Val(InputBox("请输入待求参数的X坐标"))
  
  Yk = Val(InputBox("请输入待求参数的Y坐标"))
    For j = 0 To k
     ' Qk() = Sqr((Xi - Xj) ^ 2 + (Yi - Yj) ^ 2)
     m = Sqr((Xi - Xj) ^ 2 + (Yi - Yj) ^ 2)
      Next j
      Print m
      
      
   ' Call Rect_yu
   
   
    'Call rect_multip
   
   
    'Call rect_multip
   
      
End Sub


Function Rect_yu(a() As Double, L As Long, C() As Double) As Double      '矩阵求逆
Dim T0 As Double
Dim t1 As Double
Dim t2 As Double
Dim t3 As Double
Dim B() As Double
Dim Num As Double
Dim Chay As Long
Dim Chax As Long
Chay = 0
Chax = 0
ReDim B(L - 1, L - 1)
Num = 0
Dim add As Double
add = 1 / Rect(a(), L)
For T0 = 0 To L
For t3 = 0 To L
  For t1 = 0 To L - 1
   If t1 < T0 Then
    Chax = 0
    Else
    Chax = 1
    End If
     For t2 = 0 To L - 1
      If t2 < t3 Then
       Chay = 0

     Else
     Chay = 1
     End If
     B(t1, t2) = a(t1 + Chax, t2 + Chay)
      Next t2
    Next t1
    C(t3, T0) = Rect(B(), L - 1) * add * ((-1) ^ (T0 + t3))
  Next t3
Next T0
End Function





Private Function rect_multip(a() As Double, B() As Double, n As Long, n1 As Long, n2 As Long, C() As Double) As Double    &#39;矩阵相乘
  Dim t1 As Long
  Dim t2 As Long
  Dim t3 As Long
  
  For t1 = 0 To n1
  For t2 = 0 To n2
     C(t1, t2) = 0
     For t3 = 0 To n
  C(t1, t2) = C(t1, t2) + a(t1, t3) * B(t3, t2)
  Next t3
  Next t2
  Next t1
  
End Function


Private Sub sub1()
Dim Qnn() As Integer
Const k = 1
Dim a(k, k) As Integer
   For i = 0 To k
   For j = 0 To k
      
      a(i, j) = Val(InputBox("请输入数组"))
     Next j
    Next i
   
  For i = 0 To k
   For j = 0 To k
    &#39; Qnn() = Sqr((Xi - Xj) ^ 2 + (Yi - Yj) ^ 2)
    d = Sqr((Xi - Xj) ^ 2 + (Yi - Yj) ^ 2)
     Print d
   Next j
    Print
   Next i
  &#39; Print Qnn(d, d)
   
End Sub




您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|Archiver|手机版|小黑屋|测量空间论坛 ( 闽ICP备19019609号-1 )

GMT+8, 2026-7-4 23:01 , Processed in 0.117512 second(s), 21 queries .

Powered by Discuz! X3.5

© 2001-2026 Discuz! Team.

快速回复 返回顶部 返回列表