关于测距的问题！

<P>开发环境是vb.net+AO</P>
<P>目的：实现axMapControl上的测距功能</P>
<P>我的思路：利用axMapControl本身的TrackLine功能，计算获取的pPolyline的长度，然后换算成实际长度。</P>
<P>我的问题：结果与实际长度存在较大差异！设置投影的部分我也不是很清楚，存在问题！</P>
<P>我的代码：</P>
<P>'* 1、设置地图的度量单位
                    mcMap.MapUnits = esriUnits.esriMeters</P>
<P>'* 2、设置地图的投影系统
                    Dim pSpatRefFact As ISpatialReferenceFactory2
                    pSpatRefFact = New SpatialReferenceEnvironment()
                    pSpatRefFact.GetPredefinedGeographicTransformations()</P>
<P>                    Dim m_pGeographicCoordinateSystem As IGeographicCoordinateSystem
                    Dim m_pProjectedCoordinateSystem As IProjectedCoordinateSystem
                    m_pGeographicCoordinateSystem = pSpatRefFact.CreateGeographicCoordinateSystem(esriSRGeoCSType.esriSRGeoCS_Beijing1954)
                    m_pProjectedCoordinateSystem = pSpatRefFact.CreateProjectedCoordinateSystem(esriSRProjCSType.esriSRProjCS_Beijing1954GK_13)  '=========这个地方我也不知道设得对不对，我不是很清楚自己的图的这个参数，在ArcMap里也找不到查看的位置！
                    mcMap.SpatialReference = m_pGeographicCoordinateSystem'===========这部分的设置我也不知道对不对！</P>
<P>                    '*3、获取长度
                    Dim pPolyline As IPolyline
                    pPolyline = mcMap.TrackLine
                    MsgBox("线的长度：" ; pPolyline.Length)</P>
<P>                    '*4、乘以地图的比例尺
                    MsgBox("实际长度：" ; pPolyline.Length * mcMap.MapScale)</P>
<P>我的疑问：我觉得还是投影坐标存在一定问题，方法应该是可行的，但是概念上比较糊涂，有清楚的高手给予指点啊！多谢多谢！</P><img src="images/post/smile/dvbbs/em12.gif" />

以上是我计算面积和距离的代码,仅供参考,有什么问题提出来互相讨论

<P>'----------------测量距离时用到的三个事件-----------------------------
'----------------开始-------------------------------------------------
Public Sub mapDistanceMouseDown(map As MapControl, x As Long, y As Long)
  If Not m_pPoint Is Nothing Then
    totalDistanceValue = 0
    Set pFirstPoint = m_pPoint
  End If
  Set m_pPoint = map.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
  If pFeedbackLn Is Nothing Then
    Set pFeedbackLn = New NewLineFeedback
    Set pFeedbackLn.Display = map.ActiveView.ScreenDisplay
    'pFeedbackLn.Constraint = esriLineConstraintsHorizontal
    pFeedbackLn.Start m_pPoint
  Else
    pFeedbackLn.addPoint m_pPoint
  End If
  If pFirstPoint Is Nothing Then
    totalDistanceValue = 0
  Else
    totalDistanceValue = totalDistanceValue + map.ActiveView.FocusMap.ComputeDistance(pFirstPoint, m_pPoint)
    frmMain.ActiveBar.Bands("statusbar").Tools("lengthInfo").Caption = Str(Round(totalDistanceValue, 3))
  End If
End Sub</P><P>Public Sub mapDistanceMouseMove(map As MapControl, x As Long, y As Long)
  If Not pFeedbackLn Is Nothing Then
    Set pSecondPoint = map.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
    pFeedbackLn.MoveTo pSecondPoint
    currentDistanceValue = map.ActiveView.FocusMap.ComputeDistance(pSecondPoint, m_pPoint)
    frmMain.ActiveBar.Bands("statusbar").Tools("lengthInfo").Caption = "当前长度: " ; Str(Round(map.ActiveView.FocusMap.ComputeDistance(pSecondPoint, m_pPoint), 3)) ; "  总长度：" ; Str(Round(totalDistanceValue + currentDistanceValue, 3))
  End If
End Sub</P><P>Public Sub mapDistanceDoubleClick()
  If Not pFeedbackLn Is Nothing Then
    If Not pFirstPoint Is Nothing Then
      Dim pPolyLine As IPolyline
      Set pPolyLine = pFeedbackLn.Stop
      Dim totalLength As Double
      totalLength = pPolyLine.Length
      frmMain.ActiveBar.Bands("statusbar").Tools("lengthInfo").Caption = "测量总长度为: " ; Str(Round(totalLength, 3))
    Else
      pFeedbackLn.Stop
      frmMain.ActiveBar.Bands("statusbar").Tools("lengthInfo").Caption = "测量总长度为: "
    End If
    Set pFeedbackLn = Nothing
    Set m_pPoint = Nothing
    Set pFirstPoint = Nothing
    Set pSecondPoint = Nothing
    totalDistanceValue = 0
  End If
End Sub
'----------------------结束--------------------------
'----------------------------------------------------</P><P>
'----------------------测量面积的三个事件----------------------------
'----------------------------开始------------------------------------
Public Sub mapAreaMouseDown(map As MapControl, x As Long, y As Long)
  If Not bIsMouseDown Then
    Set ptCollection = New Collection
  End If
  bIsMouseDown = True
  Set m_pPoint = map.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
  If ptCollection.Count > 0 Then
    ptCollection.Remove ptCollection.Count            '////删除鼠标移动过程中的多余点
  End If
  ptCollection.Add m_pPoint
  If pFeedbackPoly Is Nothing Then
    Set pFeedbackPoly = New NewPolygonFeedback
    Set pFeedbackPoly.Display = map.ActiveView.ScreenDisplay
    pFeedbackPoly.Start m_pPoint
  Else
    pFeedbackPoly.addPoint m_pPoint
  End If
  
  ptCollection.Add m_pPoint
  If ptCollection.Count >= 3 Then
    frmMain.ActiveBar.Bands("statusbar").Tools("lengthInfo").Caption = "测量面积为： " ; Str(Round(CalArea(ptCollection), 2))
  Else
    frmMain.ActiveBar.Bands("statusbar").Tools("lengthInfo").Caption = "至少还需要三个点才可计算面积!"
  End If
  'frmMain.ActiveBar.Bands("statusbar").Tools("companyInfo").Caption = ptCollection.Count
End Sub
Public Sub mapAreaMouseMove(map As MapControl, x As Long, y As Long)
  Set ptDisArea = map.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
  With frmMain.ActiveBar.Bands("statusbar").Tools("lengthInfo")
    If Not pFeedbackPoly Is Nothing Then
      ptCollection.Add ptDisArea
      '////放入计算出的面积代码
      Select Case ptCollection.Count
        Case 1
          .Caption = "至少还需要两个点才可计算面积!"
        Case 2
          .Caption = "至少还需要一个点才可计算面积!"
        Case Else
          .Caption = "测量面积为： " ; Str(Round(CalArea(ptCollection), 2))
      End Select
      ptCollection.Remove ptCollection.Count           '////删除鼠标移动过程中的多余点
    
      pFeedbackPoly.MoveTo ptDisArea
      'frmMain.ActiveBar.Bands("statusbar").Tools("companyInfo").Caption = ptCollection.Count
    End If
  End With
End Sub</P><P>Public Sub mapAreaDbl(map As MapControl)
  If Not pFeedbackPoly Is Nothing Then
    pFeedbackPoly.Stop
  End If
  If ptCollection.Count > 0 Then
    ptCollection.Remove ptCollection.Count           '////删除鼠标移动过程中的多余点
  End If
  Set pFeedbackPoly = Nothing
  bIsMouseDown = False
  Set ptCollection = Nothing
  Set ptDisArea = Nothing
  Set ptAreaFirst = Nothing
  Set m_pPoint = Nothing
End Sub
Private Function CalArea(col As Collection) As Double
  'If col.Count < 3 Then Exit Function
  Dim j As Long
  j = 2
  Dim k As Long
  k = 3
  Dim i As Long
  i = 1
  Dim firstPoint As IPoint
  Dim secondPoint As IPoint
  Dim thirdPoint As IPoint
  Set firstPoint = col.Item(1)
  CalArea = 0
  For i = 2 To col.Count - 1
    Set secondPoint = col.Item(i)
    Set thirdPoint = col.Item(i + 1)
    CalArea = CalArea + Abs((firstPoint.x * secondPoint.y + secondPoint.x * thirdPoint.y + thirdPoint.x * firstPoint.y - firstPoint.x * thirdPoint.y - secondPoint.x * firstPoint.y - thirdPoint.x * secondPoint.y) / 2)
  Next
  Set firstPoint = Nothing
  Set secondPoint = Nothing
  Set thirdPoint = Nothing
End Function</P><P>'----------------------------------面积量算结束-----------------------------------
'如果是多边形（凹凸均可）可以直接用叉积公式算出！
'求一个逆时针给出顶点的三角形面积?
'设顶点(x1,y1),(x2,y2),(x3,y3)
'S = (x1y2 + x2y3 + x3y1 - x1y3 - x2y1 - x3y2) / 2
'可以把一个凸多边形划分成许多互相不重叠的三角形，依次求出面积，再求和。
'但是凹多边形呢？
'注意：S大小可能为负！这点很重要。
'我们可以发现，在凹多边形中，按照原来的求法（最后再取绝对值）结果仍然是对的！
'反正先将点逆时针排序，然后确定一个顶点，依次按顺序枚举另外的两个点，对每次结果进行求和，最后取平均值。
'如上图，依次算ABC,ACD,ADE,AEF求和后取绝对值（点顺序算反影响结果）。</P>

<img src="images/post/smile/dvbbs/em05.gif" />

<img src="images/post/smile/dvbbs/em03.gif" />

不错。又学一着。<img src="images/post/smile/dvbbs/em02.gif" />

<P>恭喜，那里高手如过江之鲫</P>

嘿嘿，我知道了！
我用mcMap.TrackLine.Length获取的长度的单位是：Decimal Degrees，然后利用两个常量换算成Meters：
    Const INCH2METERS = 39.37
    Const INCH2DEGREES = 4322893.46
这样就和ArcMap里测量得到的数值是一样的了！反而写的那些转换投影什么的搞复杂了！呵呵
<P>是在ESRI英文support网站中找到的提示，大家有时间也可以多去那里看看！</P><img src="images/post/smile/dvbbs/em03.gif" /><img src="images/post/smile/dvbbs/em07.gif" />

这个例子我找到了，可是它只是一个看起来实现了的Measure，它测出来的距离值是不对的，唉！不管怎么调整地图显示单位，那个数字都不对！<img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em39.gif" />

<P>VB的reference 里面 叫做：Esri Sample Selection Commands，注意一下它指定的路径（上面帖子中）</P><P>还有要是这个不是你想要的，那我就无能为力了，因为我最讨厌投影了！！！</P>