Geometry相关的一些函数总结

下面的类中封装了Geometry相关的一些操作函数,AE+VB.Net源码。

Imports ESRI.ArcGIS.Geometry
Imports ESRI.ArcGIS.Carto
Imports ESRI.ArcGIS.Geodatabase
Imports ESRI.ArcGIS.esriSystem
Imports ESRI.ArcGIS.Display

Public Class GeometryUtility

#Region "拓扑操作函数"
  ''' <summary>
  ''' 获得extent的重心
  ''' </summary>
  ''' <param name="pGeometry">几何体</param>
  ''' <returns>返回重心点</returns>
  ''' <remarks>限于Envelope,Polygon,Ring,Multipatch</remarks>
  Shared Function GetExtentCenter(ByVal pGeometry As IGeometry) As IPoint
    If pGeometry Is Nothing Then Return Nothing : Exit Function
    Dim pArea As IArea = pGeometry
    Return pArea.Centroid
  End Function

  ''' <summary>
  ''' 得到在某个几何体范围内的feature的个数
  ''' </summary>
  ''' <param name="pGeometry">几何体</param>
  ''' <param name="pFeatureLayer">操作图层</param>
  ''' <returns>feature个数</returns>
  ''' <remarks></remarks>
  Shared Function GetFeatureCountByShape(ByVal pGeometry As IGeometry, ByVal pFeatureLayer As IFeatureLayer) As Long
    If pFeatureLayer Is Nothing Or Not (TypeOf (pFeatureLayer) Is IFeatureLayer) Or pGeometry Is Nothing Then Return 0

    Dim pFeatureClass As IFeatureClass
    Dim pSFilter As ISpatialFilter = New SpatialFilter
    Dim pQFilter As IQueryFilter
    pFeatureClass = pFeatureLayer.FeatureClass
    pSFilter.Geometry = pGeometry
    Select Case pFeatureClass.ShapeType
      Case esriGeometryType.esriGeometryPoint
        pSFilter.SpatialRel = esriSpatialRelEnum.esriSpatialRelContains
      Case esriGeometryType.esriGeometryPolyline
        pSFilter.SpatialRel = esriSpatialRelEnum.esriSpatialRelIntersects
      Case esriGeometryType.esriGeometryPolygon
        pSFilter.SpatialRel = esriSpatialRelEnum.esriSpatialRelIntersects
    End Select
    pSFilter.GeometryField = pFeatureClass.ShapeFieldName
    pQFilter = pSFilter

    Return pFeatureClass.FeatureCount(pQFilter)
  End Function

  ''' <summary>
  ''' 对单个的几何体做Clip
  ''' </summary>
  ''' <param name="pTopoGeo">被做Clip的几何体</param>
  ''' <param name="pInEnvelope">做Clip几何体</param>
  ''' <returns>做完后的geometry</returns>
  ''' <remarks>Clip几何体时要求Envelope必须是内部空的Envelope</remarks>
  Shared Function ClipGeo(ByVal pTopoGeo As ITopologicalOperator, ByVal pInEnvelope As IEnvelope) As IGeometry
    If pTopoGeo Is Nothing Or pInEnvelope Is Nothing Then Return Nothing : Exit Function
    Dim pOutGeo As IGeometry = Nothing
    Try
      If TypeOf pTopoGeo Is IPolyline Then
        pOutGeo = New Polyline
        pTopoGeo.QueryClipped(pInEnvelope, pOutGeo)
      ElseIf TypeOf pTopoGeo Is IPolygon Then
        ModifyTopoError(pTopoGeo)
        pOutGeo = New Polygon
        pTopoGeo.QueryClipped(pInEnvelope, pOutGeo)
      End If
    Catch ex As Exception
    End Try
    Return pOutGeo
  End Function
  ''' <summary>
  ''' 对单个的几何体做intersect
  ''' </summary>
  ''' <param name="pTopoGeo">被做intersect的几何体</param>
  ''' <param name="pInGeo">做intersect几何体</param>
  ''' <returns>做完后的geometry</returns>
  ''' <remarks></remarks>
  Shared Function IntersectGeo(ByVal pTopoGeo As ITopologicalOperator, ByVal pInGeo As IGeometry) As IGeometry
    If pTopoGeo Is Nothing Or pInGeo Is Nothing Then Return Nothing : Exit Function
    Dim pOutGeo As IGeometry = Nothing
    ModifyTopoError(pInGeo)
    Try
      If TypeOf pTopoGeo Is IPolyline Then
        pOutGeo = pTopoGeo.Intersect(pInGeo, esriGeometryDimension.esriGeometry1Dimension)
      ElseIf TypeOf pTopoGeo Is IPolygon Then
        ''将传入的Geometry进行拓扑修正,这样裁减出来的才是正确的
        ModifyTopoError(pTopoGeo)
        pOutGeo = pTopoGeo.Intersect(pInGeo, esriGeometryDimension.esriGeometry2Dimension)
      End If
    Catch ex As Exception
    End Try
    Return pOutGeo
  End Function
  ''' <summary>
  ''' 修正Polygon的拓扑错误
  ''' </summary>
  ''' <param name="pArea">传入的polygon</param>
  ''' <remarks></remarks>
  Shared Sub ModifyTopoError(ByVal pArea As IArea)
    If pArea.Area < 0 Then
      Try
        CType(pArea, ICurve).ReverseOrientation()
      Catch ex As Exception
      End Try
    End If
  End Sub

#End Region

#Region "生成几何体相关"
  ''' <summary>
  ''' 根据范围新建一个polygon几何体
  ''' </summary>
  ''' <param name="pExtent">范围</param>
  ''' <returns>polygon</returns>
  ''' <remarks></remarks>
  Shared Function NewPolygon(ByVal pExtent As IEnvelope) As IPolygon
    If pExtent Is Nothing Then Return Nothing : Exit Function
    Dim pSegCol As ISegmentCollection = New Polygon
    pSegCol.SetRectangle(pExtent)
    Return pSegCol
  End Function
  ''' <summary>
  ''' 根据原视图范围和新的中心点获得一个新的范围
  ''' </summary>
  ''' <param name="pNewCenter">新中心点</param>
  ''' <param name="pEnv">原视图范围</param>
  ''' <returns>新的范围</returns>
  ''' <remarks></remarks>
  Shared Function GetEnvelopeFromPointAndEnvelope(ByVal pNewCenter As IPoint, ByVal pEnv As IEnvelope) As IEnvelope
    Dim pArea As IArea = pEnv
    Dim pOldCenter As IPoint = pArea.Centroid
    Dim pTrans As ITransform2D = pEnv
    pTrans.Move(pNewCenter.X - pOldCenter.X, pNewCenter.Y - pOldCenter.Y)
    Return pTrans
  End Function
  ''' <summary>
  ''' 根据新的中心点和宽度和高度,获得一个新的视图范围
  ''' </summary>
  ''' <param name="pNewCenter"></param>
  ''' <param name="pWidth"></param>
  ''' <param name="pHeight"></param>
  ''' <returns></returns>
  ''' <remarks></remarks>
  Shared Function GetEnvelopeFromPointWidthHeight(ByVal pNewCenter As IPoint, ByVal pWidth As Double, ByVal pHeight As Double) As IEnvelope
    Dim pEnv As IEnvelope = New Envelope
    pEnv.PutCoords(pNewCenter.X - pWidth / 2, pNewCenter.Y - pHeight / 2, pNewCenter.X + pWidth / 2, pNewCenter.Y + pHeight / 2)
    Return pEnv
  End Function
  ''' <summary>
  ''' 将geometry转化为多边形
  ''' </summary>
  ''' <param name="pGeometry">传入的geometry</param>
  ''' <returns></returns>
  ''' <remarks></remarks>
  Shared Function ConvertGeometryToPolygon(ByVal pGeometry As IGeometry) As IPolygon
    Dim pPointCollection As IPointCollection = pGeometry
    Dim pNewPointCollection As IPointCollection = New PolygonClass()
    pNewPointCollection.AddPointCollection(pPointCollection)
    Dim pPolygon As IPolygon = pNewPointCollection
    Return pPolygon
  End Function

  ''' <summary>
  ''' 利用面生成闭合的曲线
  ''' </summary>
  ''' <param name="pPolygon">传入的面图形</param>
  ''' <returns></returns>
  ''' <remarks></remarks>
  Shared Function PolygonToLine(ByVal pPolygon As IPolygon) As IPolyline
    Dim pGeometryCollectionPolygon As IGeometryCollection
    Dim pClone As IClone

    Dim pSegmentCollectionPath As ISegmentCollection

    Dim pGeoCol As IGeometryCollection = New Polyline
    pClone = pPolygon
    pGeometryCollectionPolygon = pClone.Clone
    For i As Integer = 0 To pGeometryCollectionPolygon.GeometryCount
      pSegmentCollectionPath = New Path
      pSegmentCollectionPath.AddSegmentCollection(pGeometryCollectionPolygon.Geometry(i))
      pGeoCol.AddGeometry(pSegmentCollectionPath)
    Next

    Return pGeoCol
  End Function
#End Region

#Region "判断两个几何体的空间关系"
 ''' <summary>
  ''' 判断一个几何体是否包含另一个几何体
  ''' </summary>
  ''' <param name="pGeo1">包含几何体</param>
  ''' <param name="pGeo2">被包含几何体</param>
  ''' <returns>是返回true,否返回false</returns>
  ''' <remarks></remarks>
  Shared Function IsContainsGeo(ByVal pGeo1 As IGeometry, ByVal pGeo2 As IGeometry) As Boolean
    Dim pRelationalOperator As IRelationalOperator = New Envelope
    pRelationalOperator = pGeo1
    Return pRelationalOperator.Contains(pGeo2)
  End Function
  ''' <summary>
  ''' 判断一个几何体是否Overlaps另一个几何体
  ''' </summary>
  ''' <param name="pGeo1">几何体1</param>
  ''' <param name="pGeo2">几何体2</param>
  ''' <returns>是返回true,否返回false</returns>
  ''' <remarks></remarks>
  Shared Function IsOverlapsGeo(ByVal pGeo1 As IGeometry, ByVal pGeo2 As IGeometry) As Boolean
    Dim pRelationalOperator As IRelationalOperator = New Envelope
    pRelationalOperator = pGeo1
    Return pRelationalOperator.Overlaps(pGeo2)
  End Function
  ''' <summary>
  ''' 判断一个几何体是否Within另一个几何体
  ''' </summary>
  ''' <param name="pGeo1">几何体1</param>
  ''' <param name="pGeo2">几何体2</param>
  ''' <returns>是返回true,否返回false</returns>
  ''' <remarks></remarks>
  Shared Function IsWithinGeo(ByVal pGeo1 As IGeometry, ByVal pGeo2 As IGeometry) As Boolean
    Dim pRelationalOperator As IRelationalOperator = New Envelope
    pRelationalOperator = pGeo1
    Return pRelationalOperator.Within(pGeo2)
  End Function
  ''' <summary>
  ''' 判断一个几何体是否Touches另一个几何体
  ''' </summary>
  ''' <param name="pGeo1">几何体1</param>
  ''' <param name="pGeo2">几何体2</param>
  ''' <returns>是返回true,否返回false</returns>
  ''' <remarks></remarks>
  Shared Function IsTouchesGeo(ByVal pGeo1 As IGeometry, ByVal pGeo2 As IGeometry) As Boolean
    Dim pRelationalOperator As IRelationalOperator = New Envelope
    pRelationalOperator = pGeo1
    Return pRelationalOperator.Touches(pGeo2)
  End Function
  ''' <summary>
  ''' 判断两个geometry是否相同
  ''' </summary>
  ''' <param name="pGeo1">几何体1</param>
  ''' <param name="pGeo2">几何体2</param>
  ''' <returns>相同返回true,否则返回false</returns>
  ''' <remarks></remarks>
  Shared Function IsEqualGeometry(ByVal pGeo1 As IGeometry, ByVal pGeo2 As IGeometry) As Boolean
    If pGeo1 Is Nothing Then Return False
    Dim pRO As IRelationalOperator = pGeo1
    Return pRO.Equals(pGeo2)
  End Function
  ''' <summary>
  ''' 判断一个几何体是否相交另一个几何体
  ''' </summary>
  ''' <param name="pGeo1">几何体1</param>
  ''' <param name="pGeo2">几何体2</param>
  ''' <returns>是返回true,否返回false</returns>
  ''' <remarks></remarks>
  Shared Function IsCrossesGeo(ByVal pGeo1 As IGeometry, ByVal pGeo2 As IGeometry) As Boolean
    Dim pRelationalOperator As IRelationalOperator = New Envelope
    pRelationalOperator = pGeo1
    Return pRelationalOperator.Crosses(pGeo2)
  End Function
  ''' <summary>
  ''' 判断一个几何体是否有公共点另一个几何体
  ''' </summary>
  ''' <param name="pGeo1">几何体1</param>
  ''' <param name="pGeo2">几何体2</param>
  ''' <returns>是返回true,否返回false</returns>
  ''' <remarks></remarks>
  Shared Function IsDisjointGeo(ByVal pGeo1 As IGeometry, ByVal pGeo2 As IGeometry) As Boolean
    Dim pRelationalOperator As IRelationalOperator = New Envelope
    pRelationalOperator = pGeo1
    Return pRelationalOperator.Disjoint(pGeo2)
  End Function
#End Region

#Region "几何体操作相关"
  ''' <summary>
  ''' 线上距离FromPoint的DisOnLine距离上的一点,在这点处把线打断为两段
  ''' </summary>
  ''' <param name="myPolyline">传入的限图形</param>
  ''' <param name="DisOnLine">离FromPoint的距离</param>
  ''' <returns></returns>
  ''' <remarks></remarks>
  Shared Function BreakLineToTwoPart(ByVal myPolyline As IPolyline, ByVal disOnLine As Double) As IPolyline()
    If disOnLine < myPolyline.Length Then
      Return Nothing
    End If
    Dim Lines(0 To 1) As IPolyline
    Dim isSplit As Boolean
    Dim splitIndex, segIndex As Integer
    myPolyline.SplitAtDistance(disOnLine, False, False, isSplit, splitIndex, segIndex)
    Dim newLine As IPolyline = New Polyline
    Dim lineSegCol As ISegmentCollection = myPolyline
    Dim newSegCol As ISegmentCollection = newLine
    For j As Integer = segIndex To lineSegCol.SegmentCount
      newSegCol.AddSegment(lineSegCol.Segment(j))
    Next
    lineSegCol.RemoveSegments(segIndex, lineSegCol.SegmentCount - segIndex, True)
    lineSegCol.SegmentsChanged()
    newSegCol.SegmentsChanged()

    Dim oldLine As IPolyline = lineSegCol
    newLine = newSegCol
    Lines(0) = oldLine
    Lines(1) = newLine
    Return Lines
  End Function
  ''' <summary>
  ''' 在SplitePoint处打断线要素的图形,并去除新的线
  ''' </summary>
  ''' <param name="LineCurve">传入的线</param>
  ''' <param name="splitePoint">线上的一点</param>
  ''' <returns></returns>
  ''' <remarks></remarks>
  Shared Function SpliteLineAtPoint(ByVal lineCurve As IPolyline, ByVal splitePoint As IPoint) As IPolyline()
    Dim Lines(0 To 1) As IPolyline
    Dim isSplit As Boolean
    Dim splitIndex, segIndex As Integer
    lineCurve.SplitAtPoint(splitePoint, True, False, isSplit, splitIndex, segIndex)
    If isSplit Then
      Dim newLine As IPolyline = New Polyline
      Dim lineSegCol As ISegmentCollection = lineCurve
      Dim newSegCol As ISegmentCollection = newLine
      For j As Integer = segIndex To lineSegCol.SegmentCount
        newSegCol.AddSegment(lineSegCol.Segment(j))
      Next
      lineSegCol.RemoveSegments(segIndex, lineSegCol.SegmentCount - segIndex, True)
      lineSegCol.SegmentsChanged()
      newSegCol.SegmentsChanged()
      Dim oldLine As IPolyline = lineSegCol
      newLine = newSegCol
      Lines(0) = newLine
      Lines(1) = oldLine
    End If
    Return Lines
  End Function
  ''' <summary>
  ''' 用一个面图形把一个面要素切割为两部分
  ''' </summary>
  ''' <param name="polyClass">面要素集</param>
  ''' <param name="polyFeat">面要素</param>
  ''' <param name="cutPolygon">用于切割的图形</param>
  ''' <remarks></remarks>
  Shared Sub BreakPolygonToTwoPart(ByVal polyClass As IFeatureClass, ByVal polyFeat As IFeature, ByVal cutPolygon As IPolygon)
    Dim featGeo As IGeometry = polyFeat.Shape

    Dim topo As ITopologicalOperator = featGeo
    Dim pOutGeometry As IGeometry = topo.Difference(cutPolygon)
    If TypeOf pOutGeometry Is IGeometryCollection Then
      Dim pGeometryCollection As IGeometryCollection = pOutGeometry
      For i As Integer = 0 To pGeometryCollection.GeometryCount
        Dim pGeometry As IGeometry = pGeometryCollection.Geometry(i)
        If pGeometry IsNot Nothing And Not pGeometry.IsEmpty And pGeometry.GeometryType = esriGeometryType.esriGeometryRing Then
          Dim pClone As IClone = pGeometry
          Dim pPolygon As IPolygon = ConvertGeometryToPolygon(pClone.Clone)
          If pPolygon IsNot Nothing And Not pPolygon.IsEmpty Then
            Dim pNewFeature As IFeature = polyClass.CreateFeature()
            pNewFeature.Shape = pPolygon
            pNewFeature.Store()
          End If

        End If
      Next
      polyFeat.Delete()
    End If
  End Sub
  Public Enum EnvExtentLineType
    FromPoint = 0
    ToPoint = 1
    BothPoint = 2
  End Enum
  ''' <summary>
  ''' 延长线段
  ''' </summary>
  ''' <param name="passLine">传入的线</param>
  ''' <param name="mode">模式,0为从FromPoint处延长,1为从ToPint处延长,2为两端延长</param>
  ''' <param name="dis">延长的距离</param>
  ''' <returns></returns>
  ''' <remarks></remarks>
  Shared Function GetExtendLine(ByVal passLine As IPolyline, ByVal mode As EnvExtentLineType, ByVal dis As Double) As IPolyline
    Dim pPointCol As IPointCollection = passLine
    Select Case mode
      Case EnvExtentLineType.FromPoint
        Dim fromPoint As IPoint = New Point
        passLine.QueryPoint(esriSegmentExtension.esriExtendAtFrom, -1 * dis, False, fromPoint)
        pPointCol.InsertPoints(0, 1, fromPoint)
        Exit Select
      Case EnvExtentLineType.ToPoint
        Dim endPoint As IPoint = New Point
        passLine.QueryPoint(esriSegmentExtension.esriExtendAtTo, dis + passLine.Length, False, endPoint)
        pPointCol.AddPoint(endPoint)
        Exit Select
      Case EnvExtentLineType.BothPoint
        Dim fPoint As IPoint = New Point
        Dim ePoint As IPoint = New Point
        passLine.QueryPoint(esriSegmentExtension.esriExtendAtFrom, -1 * dis, False, fPoint)
        pPointCol.InsertPoints(0, 1, fPoint)
        passLine.QueryPoint(esriSegmentExtension.esriExtendAtTo, dis + passLine.Length, False, ePoint)
        pPointCol.AddPoint(ePoint)
      Case Else
        Return pPointCol
    End Select
    Return pPointCol
  End Function
#End Region

 #Region "计算相关函数"
  ''' <summary>
  ''' 返回点到图形之间的垂直距离
  ''' </summary>
  ''' <param name="pPoint"></param>
  ''' <param name="pGeo"></param>
  ''' <returns></returns>
  ''' <remarks></remarks>
  Shared Function GetPointToGeoDis(ByVal pPoint As IPoint, ByVal pGeo As IGeometry) As Double
    Dim pro As IProximityOperator = pPoint
    Dim dis As Double = pro.ReturnDistance(pGeo)
    Return dis
  End Function

  ''' <summary>
  ''' 求两点间距离
  ''' </summary>
  ''' <param name="p1"></param>
  ''' <param name="p2"></param>
  ''' <returns></returns>
  ''' <remarks></remarks>
  Shared Function GetDisByTwoPoint(ByVal p1 As IPoint, ByVal p2 As IPoint) As Double
    Dim step1 As Double = (p1.X - p2.X) * (p1.X - p2.X) + (p1.Y - p2.Y) * (p1.Y - p2.Y)
    Dim step2 As Double = Math.Sqrt(step1)
    Return step2
  End Function

  ''' <summary>
  ''' 利用两点生成一条PolyLine
  ''' </summary>
  ''' <param name="p1"></param>
  ''' <param name="p2"></param>
  ''' <returns></returns>
  ''' <remarks></remarks>
  Shared Function CreatePolyLineByTwoPoint(ByVal p1 As IPoint, ByVal p2 As IPoint) As IPolyline
    Dim pLineFeed As INewLineFeedback = New NewLineFeedback
    pLineFeed.Start(p1)
    pLineFeed.AddPoint(p2)
    Dim pPolyLine As IPolyline = pLineFeed.Stop()
    Return pPolyLine

  End Function

  ''' <summary>
  ''' 粗略判断一个已知点是否在线上
  ''' </summary>
  ''' <param name="pPoint">已知点</param>
  ''' <param name="myLine"></param>
  ''' <returns></returns>
  ''' <remarks></remarks>
  Shared Function IsPointOnLine(ByVal pPoint As IPoint, ByVal myLine As IPolyline) As Boolean
    Dim topo As ITopologicalOperator = pPoint
    Dim buffer As IGeometry = topo.Buffer(0.00001)
    topo = buffer
    Dim pgeo As IGeometryCollection = topo.Intersect(myLine, esriGeometryDimension.esriGeometry0Dimension)
    Dim result As Boolean = False
    If pgeo.GeometryCount > 0 Then result = True
    Return result
  End Function
  ''' <summary>
  ''' 利用三点求角度(余弦定理)
  ''' </summary>
  ''' <param name="p1"></param>
  ''' <param name="p2"></param>
  ''' <param name="p3"></param>
  ''' <returns></returns>
  ''' <remarks></remarks>
  Shared Function GetAngleByThreePoint(ByVal p1 As IPoint, ByVal p2 As IPoint, ByVal p3 As IPoint) As Double
    Dim a As Double = GetDisByTwoPoint(p1, p2)
    Dim b As Double = GetDisByTwoPoint(p1, p3)
    Dim c As Double = GetDisByTwoPoint(p2, p3)
    Dim cosB As Double = (a * a + c * c - b * b) / (2 * a * c)
    Dim angle As Double = Math.Acos(cosB)
    Return angle
  End Function

  ''' <summary>
  ''' 返回两点所组成的直线的角度(平面坐标角度)
  ''' </summary>
  ''' <param name="p1"></param>
  ''' <param name="p2"></param>
  ''' <returns>弧度值</returns>
  ''' <remarks></remarks>
  Shared Function GetAngle(ByVal p1 As IPoint, ByVal p2 As IPoint) As Double
    Dim x As Double = p1.Y - p2.Y
    Dim y As Double = p1.X - p2.X
    Dim tan As Double = x / y
    Dim angle As Double = Math.Atan(tan)
    Return angle
  End Function
  ''' <summary>
  ''' 返回以p1为起点,p2为终点的直线的极坐标角度(逆时针为正,顺时针为负)
  ''' </summary>
  ''' <param name="p1"></param>
  ''' <param name="p2"></param>
  ''' <returns>弧度值</returns>
  ''' <remarks></remarks>
  Shared Function GetAngle2(ByVal p1 As IPoint, ByVal p2 As IPoint) As Double
    Dim pLine As ILine = New LineClass()
    pLine.PutCoords(p1, p2)
    Return pLine.Angle
  End Function
#End Region

End Class


posted @ 2010-06-09 12:19  zhh  阅读(4630)  评论(0编辑  收藏  举报