请教VB＋AO对多边面积量算？

图层为经纬度坐标，计算多边形面积时用IArea接口获取的面积都小于1，如何换算成单位为平方米？<img src="images/post/smile/dvbbs/em09.gif" />

转换投影坐标。参考：
'--------------------------------------------------------------------------
'目的：TransCoordsEx说明：转地理坐标到投影坐标
'输入：pGeo--要转换的地理实体
'输出：IGeometry（转换后的）
'作者：
'日期:2003.08.20
'--------------------------------------------------------------------------
Function TransCoordEx(pGeo As IGeometry2, lngFromGeoCS As Long, lngToProjCS As Long) As IGeometry2
    Dim pGCS1 As IGeographicCoordinateSystem
    Dim pSpRef1 As ISpatialReference
    Dim pSpRFc1 As SpatialReferenceEnvironment
    Dim pPCS2 As IProjectedCoordinateSystem
    Dim pSpRef2 As ISpatialReference
    Dim pSpRFc2 As SpatialReferenceEnvironment
    On Error Resume Next
    
    Set pSpRFc1 = New SpatialReferenceEnvironment
    'Set pGCS1 = pSpRFc1.CreateGeographicCoordinateSystem(esriSRGeoCS_WGS1984)
    Set pGCS1 = pSpRFc1.CreateGeographicCoordinateSystem(esriSRGeoCS_Krasovsky1940)
  
    Set pGCS1 = pSpRFc1.CreateGeographicCoordinateSystem(lngFromGeoCS)
    Set pSpRef1 = pGCS1
    
    ' Project to RijksDriekhoek
    Set pSpRFc2 = New SpatialReferenceEnvironment
    Set pPCS2 = pSpRFc2.CreateProjectedCoordinateSystem(lngToProjCS)
'    Set pPCS2 = pSpRFc2.CreateProjectedCoordinateSystem(g_pMap.SpatialReference.FactoryCode)
   Set pPCS2 = pSpRFc2.CreateProjectedCoordinateSystem(esriSRProjCS_Beijing1954GK_20)
    
    Set pSpRef2 = pPCS2
    '?????????????????????????????????
    Dim pGeoTrans As IGeoTransformation
    Dim pSpatRefFact As ISpatialReferenceFactory

    Set pSpatRefFact = New SpatialReferenceEnvironment
    Set pGeoTrans = pSpatRefFact.CreateGeoTransformation(esriSRGeoTransformation_Amersfoort_To_WGS1984)
    pGeo.ProjectEx pPCS2, esriTransformForward, pGeoTrans, 0, 0, 0
  
   Set TransCoordEx = pGeo
    Set pGCS1 = Nothing
    Set pSpRef1 = Nothing
    Set pSpRFc1 = Nothing
    Set pPCS2 = Nothing
    Set pSpRef2 = Nothing
    Set pSpRFc2 = Nothing
    Set pGeoTrans = Nothing
    Set pSpatRefFact = Nothing
    Set pGeo = Nothing
End Function

调用方法为：
...
Set pFeaCursor = pFClass.Search(Nothing, False)
Set pFeature = pFeaCursor.NextFeature
Dim pGeo As IGeometry2
Dim pGeo2 As IGeometry2
 Dim dblArea As Double
 Dim pArea As IArea
 While Not pFeature Is Nothing
     Set pRow = pFeature
     'Set pGeo = TransCoords(pFeature.Shape, 4024, 21420)
     Set pGeo = pFeature.Shape
     Set pGeo2 = TransCoordEx(pGeo, 4024, 21420)
     Set pArea = pGeo2
     dblArea = pArea.Area
     pRow.Value(pRow.Fields.FindField(strAreaFld)) = dblArea
     pRow.Store
  Set pFeature = pFeaCursor.NextFeature
 Wend
  pWorkspaceEdit.StopEditOperation
 pWorkspaceEdit.StopEditing True
以上只供参考

rainsnow
好弓虽啊

好贴！支持

顶

支持

强人

好，不错

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