构造一个多Ring的Polygon
在一些投影运算中，我们需要将Geometry的进行“点－点”形式的转换，这个操作可以通过IPointCollection来直接完成，但如果我们需要对付的是具有多个Path的Polyline或多个Ring的Polygon，则问题就比较复杂，不能再直接使用IPointCollection的方式来实现 ，而是需要考虑多个Ring甚至是岛的情况。
下面的VBA代码，可以将一个任意的Polygon复制一份，保存到同一要素类中：
Dim pm As IMxDocument
Set pm = ThisDocument
Dim pEnumFeat As IEnumFeature
Set pEnumFeat = pm.FocusMap.FeatureSelection
Dim i As Long
Dim pGonColl As IGeometryCollection
Dim pExteriorRing() As IRing
Dim pPolygon As IPolygon
'Loop over all polygon
Dim pFeature As IFeature
Set pFeature = pEnumFeat.Next
Dim pFL As IFeatureLayer
Set pFL = pm.FocusMap.Layer(0)
Dim pFC As IFeatureClass
Set pFC = pFL.FeatureClass
While Not pFeature Is Nothing
Dim ps As IGeometryCollection－－>它将用来装复制的Polygon
If pFeature.Shape.GeometryType = esriGeometryPolygon Then
Set ps = New Polygon
Set pPolygon = pFeature.ShapeCopy-->源Polygon
ReDim pExteriorRing(pPolygon.ExteriorRingCount - 1)
pPolygon.QueryExteriorRings pExteriorRing(0)--->找到这个Polygon所有的外RING
For i = 0 To pPolygon.ExteriorRingCount - 1
ps.AddGeometry pExteriorRing(i)--->将这些外RING装入ps中，如果是投影的话，可以在这里处理
Dim pInteriorRing() As IRing
ReDim pInteriorRing(pPolygon.InteriorRingCount(pExteriorRing(i)) - 1)
pPolygon.QueryInteriorRings pExteriorRing(i), pInteriorRing(0)-->找到每个外RING包含的内部RING
Dim j As Long
For j = 0 To pPolygon.InteriorRingCount(pExteriorRing(i)) - 1
ps.AddGeometry pInteriorRing(j)-->也将它们装入ps中
Next
Next
End If
Dim pF As IFeature
Set pF = pFC.CreateFeature
Set pF.Shape = ps
pF.Store
Set pFeature = pEnumFeat.Next
Wend
Related Items
Comments
Leave a comment
Or, take a look at Archives and Categories
