Geometry相关的一些函数总结
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
