The following code demonstrates how to create valid polygons efficiently.
[VBA]
- createMultipartPolygonRingSegmentCollection: Create a multipart polygon using rings via ISegmentCollection.
- createMultipartPolygonRingPointCollection: Create a multipart polygon using rings via IPointCollection.
- createSinglepartPolygonPointCollection: Create a single part polygon via IPointCollection.
- createSinglepartPolygonSegmentCollection: Create a single part polygon via ISegmentCollection.
- createRectanglePolygonFromEnvelope: Convert an envelope to a polygon via ISegmentCollection.
How to use
- Use this code in VBA
'************************************************************************************************
'* GEOMETRY TYPE : POLYGON
'* NOTE :In the following samples the geometries are simple without having to use ITopologicalOpeartor::Simplify.
'* However if the data creation process cannot insure simple geometries
'* the geometries have to be simplified before storing or using those in geometry operations.
'************************************************************************************************
'*************************************************************************
'* NAME : createMultipartPolygonRingSegmentCollection
'* DESCRIPTION :Create a multipart polygon using rings via ISegmentCollection.
'* This sub is demonstrating it by creating 1001
'* concentric square rings and add those to a polygon.
'* NOTE : This is the approach to use if non-linear segments (Circular Arc, Elliptical Arc and Bezier Curve) have to be created.
'*************************************************************************
Private Sub createMultipartPolygonRingSegmentCollection()
Dim pPointsRing0(3) As IPoint, pPointsRing1(3) As IPoint, i As Long, pGonColl As IGeometryCollection
Dim pRingColl(1) As ISegmentCollection
Dim d0X0 As Double, d0X1 As Double, d0X2 As Double, d0X3 As Double, d0Y0 As Double, d0Y1 As Double
Dim d0Y2 As Double, d0Y3 As Double, d1X0 As Double, d1X1 As Double, d1X2 As Double, d1X3 As Double
Dim d1Y0 As Double, d1Y1 As Double, d1Y2 As Double, d1Y3 As Double, j As Long, k As Long
Dim pLine0(3) As ILine, pLine1(3) As ILine, pSeg0(3) As ISegment, pSeg1(3) As ISegment, pGeometry(1) As IGeometry
Dim pspref As ISpatialReference, pGeoSpRef As IGeometry
Dim pTopoOp2 As ITopologicalOperator2
Set pGonColl = New Polygon
'*********************************************************
'THE SPATIAL REFERENCE SHOULD BE SET HERE ON THE POLYGON
'Here the spatial reference is created in memory but could also come from various sources:
'IMap, IGeodataset, IGeometry etc...
Set pspref = New UnknownCoordinateSystem
pspref.SetFalseOriginAndUnits -10000, -10000, 100000 'Set the false origin and units.
'The XYUnits value is equivalent to the precision specified when creating a feature class
Set pGeoSpRef = pGonColl
Set pGeoSpRef.SpatialReference = pspref
'*********************************************************
'Initialize offset values
d0X0 = 0
d0Y0 = 0
d0X1 = 0
d0Y1 = 0
d0X2 = 0
d0Y2 = 0
d0X3 = 0
d0Y3 = 0
d1X0 = 10000
d1Y0 = 10000
d1X1 = 10000
d1Y1 = 10000
d1X2 = 10000
d1Y2 = 10000
d1X3 = 10000
d1Y3 = 10000
'Initialize the points
For k = 0 To 3
Set pPointsRing0(k) = New EsriGeometry.Point
Set pPointsRing1(k) = New EsriGeometry.Point
Next k
'Loop to change the coordinates of the points
For i = 0 To 1000
Set pRingColl(0) = New Ring
Set pRingColl(1) = New Ring
'Lines are passed by reference to the polygon using ISegmentCollection
'so a new line has to be instantiated to avoid the polygon to become degenerated
For k = 0 To 3
Set pLine0(k) = New EsriGeometry.Line
Set pLine1(k) = New EsriGeometry.Line
'QI (Query interface) to make sure that we have the correct type of geometry
'when passing these arrays to the addsegments.
'If passing directly the lines array it will fatal VB. This is a known limit of VB.
Set pSeg0(k) = pLine0(k)
Set pSeg1(k) = pLine1(k)
Next
Set pGeometry(0) = pRingColl(0)
Set pGeometry(1) = pRingColl(1)
d0X0 = d0X0 - 5
d0Y0 = d0Y0 - 5
d0X1 = d0X1 + 5
d0Y1 = d0Y1 - 5
d0X2 = d0X2 + 5
d0Y2 = d0Y2 + 5
d0X3 = d0X3 - 5
d0Y3 = d0Y3 + 5
'Put the coordinates of the points to use in the first ring
pPointsRing0(0).PutCoords d0X0, d0Y0
pPointsRing0(1).PutCoords d0X1, d0Y1
pPointsRing0(2).PutCoords d0X2, d0Y2
pPointsRing0(3).PutCoords d0X3, d0Y3
d1X0 = d1X0 - 5
d1Y0 = d1Y0 - 5
d1X1 = d1X1 + 5
d1Y1 = d1Y1 - 5
d1X2 = d1X2 + 5
d1Y2 = d1Y2 + 5
d1X3 = d1X3 - 5
d1Y3 = d1Y3 + 5
'Put the coordinates of the points to use in the second ring
pPointsRing1(0).PutCoords d1X0, d1Y0
pPointsRing1(1).PutCoords d1X1, d1Y1
pPointsRing1(2).PutCoords d1X2, d1Y2
pPointsRing1(3).PutCoords d1X3, d1Y3
'Put the coordinates of the lines
pLine0(0).PutCoords pPointsRing0(0), pPointsRing0(1)
pLine0(1).PutCoords pPointsRing0(1), pPointsRing0(2)
pLine0(2).PutCoords pPointsRing0(2), pPointsRing0(3)
pLine0(3).PutCoords pPointsRing0(3), pPointsRing0(0)
pLine1(0).PutCoords pPointsRing1(0), pPointsRing1(1)
pLine1(1).PutCoords pPointsRing1(1), pPointsRing1(2)
pLine1(2).PutCoords pPointsRing1(2), pPointsRing1(3)
pLine1(3).PutCoords pPointsRing1(3), pPointsRing1(0)
'Add the segments to the rings
pRingColl(0).AddSegments 4, pSeg0(0)
pRingColl(1).AddSegments 4, pSeg1(0)
'Add the rings to the polygon
pGonColl.AddGeometries 2, pGeometry(0)
Next
Set pTopoOp2 = pGonColl
pTopoOp2.IsKnownSimple = False
pTopoOp2.Simplify
'You can draw, store or use the polygon (pGonColl) in other geometry operations at this point
End Sub
'*************************************************************************
'* NAME : createMultipartPolygonRingPointCollection
'* DESCRIPTION : Create a multipart polygon using rings via IPointCollection.
'* This sub is demonstrating it by creating 1001
'* concentric square rings and add those to a polygon.
'*************************************************************************
Private Sub createMultipartPolygonRingPointCollection()
Dim pPointsRing0(4) As IPoint, pPointsRing1(4) As IPoint, pRingsColl(1) As IPointCollection
Dim pGeometry(1) As IGeometry, i As Long, pGonColl As IGeometryCollection
Dim d0X0 As Double, d0X1 As Double, d0X2 As Double, d0X3 As Double, d0Y0 As Double, d0Y1 As Double
Dim d0Y2 As Double, d0Y3 As Double, d1X0 As Double, d1X1 As Double, d1X2 As Double, d1X3 As Double
Dim d1Y0 As Double, d1Y1 As Double, d1Y2 As Double, d1Y3 As Double, j As Long, k As Long
Dim pspref As ISpatialReference, pGeoSpRef As IGeometry
Dim pTopoOp2 As ITopologicalOperator2
'Create the resulting polygon
Set pGonColl = New Polygon
'*********************************************************
'THE SPATIAL REFERENCE SHOULD BE SET HERE ON THE POLYGON
'Here the spatial reference is created in memory but could also come from various sources:
'IMap, IGeodataset, IGeometry etc...
Set pspref = New UnknownCoordinateSystem
pspref.SetFalseOriginAndUnits -10000, -10000, 100000 'Set the false origin and units.
'The XYUnits value is equivalent to the precision specified when creating a feature class
Set pGeoSpRef = pGonColl
Set pGeoSpRef.SpatialReference = pspref
'*********************************************************
d0X0 = 0
d0Y0 = 0
d0X1 = 0
d0Y1 = 0
d0X2 = 0
d0Y2 = 0
d0X3 = 0
d0Y3 = 0
d1X0 = 10000
d1Y0 = 10000
d1X1 = 10000
d1Y1 = 10000
d1X2 = 10000
d1Y2 = 10000
d1X3 = 10000
d1Y3 = 10000
'Loop to change the coordinates of the points
For i = 0 To 1000
Set pRingsColl(0) = New Ring
Set pRingsColl(1) = New Ring
'QI(Query Interface) to make sure that we have the correct type of geometry when passing this array to the addsegments
Set pGeometry(0) = pRingsColl(0)
Set pGeometry(1) = pRingsColl(1)
'Create the new points
For k = 0 To 4
Set pPointsRing0(k) = New EsriGeometry.Point
Set pPointsRing1(k) = New EsriGeometry.Point
Next
d0X0 = d0X0 - 5
d0Y0 = d0Y0 - 5
d0X1 = d0X1 + 5
d0Y1 = d0Y1 - 5
d0X2 = d0X2 + 5
d0Y2 = d0Y2 + 5
d0X3 = d0X3 - 5
d0Y3 = d0Y3 + 5
'Put the coordinates of the points to use in the first ring
pPointsRing0(0).PutCoords d0X0, d0Y0
pPointsRing0(1).PutCoords d0X1, d0Y1
pPointsRing0(2).PutCoords d0X2, d0Y2
pPointsRing0(3).PutCoords d0X3, d0Y3
pPointsRing0(4).PutCoords d0X0, d0Y0
'Add the points to the ring
pRingsColl(0).AddPoints 5, pPointsRing0(0)
d1X0 = d1X0 - 5
d1Y0 = d1Y0 - 5
d1X1 = d1X1 + 5
d1Y1 = d1Y1 - 5
d1X2 = d1X2 + 5
d1Y2 = d1Y2 + 5
d1X3 = d1X3 - 5
d1Y3 = d1Y3 + 5
'Put the coordinates of the points to use in the second ring
pPointsRing1(0).PutCoords d1X0, d1Y0
pPointsRing1(1).PutCoords d1X1, d1Y1
pPointsRing1(2).PutCoords d1X2, d1Y2
pPointsRing1(3).PutCoords d1X3, d1Y3
pPointsRing1(4).PutCoords d1X0, d1Y0
'Add the points to the ring
pRingsColl(1).AddPoints 5, pPointsRing1(0)
'Add the rings to the polygon
pGonColl.AddGeometries 2, pGeometry(0)
Next
Set pTopoOp2 = pGonColl
pTopoOp2.IsKnownSimple = False
pTopoOp2.Simplify
'You can draw, store or use the polygon (pGonColl) in other geometry operations at this point
End Sub
'*************************************************************************
'* NAME : createSinglepartPolygonPointCollection
'* DESCRIPTION : Create a single part polygon via IPointCollection.
'*************************************************************************
Private Sub createSinglepartPolygonPointCollection()
Dim pGonColl As IPointCollection
Dim pPoint(4) As IPoint
Dim i As Long
Dim pspref As ISpatialReference, pGeoSpRef As IGeometry
Dim pTopoOp2 As ITopologicalOperator2
Set pGonColl = New Polygon
'*********************************************************
'THE SPATIAL REFERENCE SHOULD BE SET HERE ON THE POLYGON
'Here the spatial reference is created in memory but could also come from various sources:
'IMap, IGeodataset, IGeometry etc...
Set pspref = New UnknownCoordinateSystem
pspref.SetFalseOriginAndUnits -10000, -10000, 100000 'Set the false origin and units.
'The XYUnits value is equivalent to the precision specified when creating a feature class
Set pGeoSpRef = pGonColl
Set pGeoSpRef.SpatialReference = pspref
'*********************************************************
'Initialize the points
For i = 0 To 4
Set pPoint(i) = New EsriGeometry.Point
Next
pPoint(0).PutCoords 0, 0
pPoint(1).PutCoords 10, 0
pPoint(2).PutCoords 10, 10
pPoint(3).PutCoords 0, 10
pPoint(4).PutCoords 0, 0
'Add the points to the polygon
pGonColl.AddPoints 5, pPoint(0)
Set pTopoOp2 = pGonColl
pTopoOp2.IsKnownSimple = False
pTopoOp2.Simplify
'You can draw, store or use the polygon (pGonColl) in other geometry operations at this point
End Sub
'*************************************************************************
'* NAME : createSinglepartPolygonSegmentCollection
'* DESCRIPTION : Create a single part polygon via ISegmentCollection.
'*************************************************************************
Private Sub createSinglepartPolygonSegmentCollection()
Dim pGonColl As ISegmentCollection
Dim pPoint(4) As IPoint
Dim pLine(3) As ILine
Dim pSegment(3) As ISegment
Dim i As Long
Dim pspref As ISpatialReference, pGeoSpRef As IGeometry
Dim pTopoOp2 As ITopologicalOperator2
Set pGonColl = New Polygon
'*********************************************************
'THE SPATIAL REFERENCE SHOULD BE SET HERE ON THE POLYGON
'Here the spatial reference is created in memory but could also come from various sources:
'IMap, IGeodataset, IGeometry etc...
Set pspref = New UnknownCoordinateSystem
pspref.SetFalseOriginAndUnits -10000, -10000, 100000 'Set the false origin and units.
'The XYUnits value is equivalent to the precision specified when creating a feature class
Set pGeoSpRef = pGonColl
Set pGeoSpRef.SpatialReference = pspref
'*********************************************************
'Initialize things
For i = 0 To 3
Set pLine(i) = New EsriGeometry.Line
Set pPoint(i) = New EsriGeometry.Point
Set pSegment(i) = pLine(i)
Next
'Put the coordinates of the points
pPoint(0).PutCoords 0, 0
pPoint(1).PutCoords 10, 0
pPoint(2).PutCoords 10, 10
pPoint(3).PutCoords 0, 10
'Put the coordinates of the line
pLine(0).PutCoords pPoint(0), pPoint(1)
pLine(1).PutCoords pPoint(1), pPoint(2)
pLine(2).PutCoords pPoint(2), pPoint(3)
pLine(3).PutCoords pPoint(3), pPoint(0)
'Add the segments in the polygon via the ISegmentCollection
pGonColl.AddSegments 4, pSegment(0)
Set pTopoOp2 = pGonColl
pTopoOp2.IsKnownSimple = False
pTopoOp2.Simplify
'You can draw or store the polygon (pGonColl)
End Sub
'*************************************************************************
'* NAME : CreateRectanglePolygonFromEnvelope
'* DESCRIPTION : Convert an envelope to a polygon via ISegmentCollection
'*************************************************************************
Private Sub CreateRectanglePolygonFromEnvelope()
Dim pEnvelope As IEnvelope
Dim pSegmentColl As ISegmentCollection
Dim pspref As ISpatialReference
Set pEnvelope = New Envelope
'*********************************************************
'THE SPATIAL REFERENCE SHOULD BE SET HERE ON THE ENVELOPE
'Here the spatial reference is created in memory but could also come from various sources:
'IMap, IGeodataset, IGeometry etc...
Set pspref = New UnknownCoordinateSystem
pspref.SetFalseOriginAndUnits -10000, -10000, 100000 'Set the false origin and units.
'The XYUnits value is equivalent to the precision specified when creating a feature class
Set pEnvelope.SpatialReference = pspref
'*********************************************************
pEnvelope.PutCoords 0, 0, 100, 100
Set pSegmentColl = New Polygon
pSegmentColl.SetRectangle pEnvelope 'This is transferring the spatial reference
'You can draw or store the polygon (pSegmentColl)
End Sub