Create Polygon From A Point Feature Class Containing An Area Field

Created:04/18/2002
Description:

The createPolygonFromArea function below shows how you can create a new Polygon (Square or Circle) object using one point as center and an area field.

You can try this function out by running the Main sub.



How to use:
  1. Open ArcMap, open the VBA editor and paste the code below into the code window.
  2. Add a polygon layer (Output) in position 0 in ArcMap and add a point feature class containing one field containing the area of the desired polygon in position 1 (In the table of contents).
  3. Change the index of the value propriety to the area field index in your point feature class.
  4. Choose if you want to create square polygons or circular polygons by setting the isSquare parameter in the createPolygonFromArea.
  5. Run the Main sub. It should create a number of polygons equal to the number of points with an area equal to the one contains in the specified field.
Option Explicit

Sub main()
On Error GoTo errHand
Dim pm As IMxDocument
Set pm = ThisDocument
Dim pfl As IFeatureLayer
Set pfl = pm.FocusMap.Layer(0) 'Specify the output polygon layer
Dim ptfl As IFeatureLayer
Set ptfl = pm.FocusMap.Layer(1) 'Specify the input point layer
If Not pfl.FeatureClass.ShapeType = esriGeometryPolygon Then
   MsgBox "The first layer in your TOC should be of type polygon"
   Exit Sub
End If
If Not ptfl.FeatureClass.ShapeType = esriGeometryPoint Then
   MsgBox "The second layer in your TOC should be of type point"
   Exit Sub
End If
Dim pfcls As IFeatureClass
Set pfcls = pfl.FeatureClass
Dim pPolygon As IPolygon
Dim pfc As IFeatureCursor
Set pfc = ptfl.FeatureClass.Search(Nothing, True)
Dim pf As IFeature
Set pf = pfc.NextFeature
While Not pf Is Nothing
   'Change the index in value to specify the field containing the area the right field 0 is the first field
   Set pPolygon = createPolygonFromArea(pf.Value(3), pf.ShapeCopy, False)  '(area field,point from the feature class point,isSquare)
   Set pf = pfc.NextFeature
   storeFeature pPolygon, pfcls
Wend
Exit Sub
errHand:
MsgBox Err.Description

End Sub
'Create a square polygon or a circular polygon based on a specific area
Private Function createPolygonFromArea(dArea As Double, pCenter As IPoint, bIsSquare As Boolean) As IPolygon
Dim pgoncoll As ISegmentCollection
Set pgoncoll = New Polygon
If bIsSquare Then
   Dim db As Double
   db = Sqr(dArea)
   Dim penv As IEnvelope
   Set penv = New Envelope
   penv.PutCoords pCenter.X - (db / 2), pCenter.Y - (db / 2), pCenter.X + (db / 2), pCenter.Y + (db / 2)
   pgoncoll.SetRectangle penv
Else
   Dim dr As Double
   Dim dpi As Double
   dpi = Atn(1) * 4
   dr = Sqr(dArea / dpi)
   pgoncoll.SetCircle pCenter, dr
End If
   Set createPolygonFromArea = pgoncoll
End Function
'Store the geometry in the specified feature class
Private Sub storeFeature(pGeo As IGeometry, pFClass As IFeatureClass)
   On Error GoTo errHand
   Dim pNewFCursor As IFeatureCursor
   Dim pFeatureBuffer As IFeatureBuffer
   Set pNewFCursor = pFClass.Insert(True)
   Set pFeatureBuffer = pFClass.CreateFeatureBuffer
   Set pFeatureBuffer.Shape = pGeo
   pNewFCursor.InsertFeature pFeatureBuffer
   pNewFCursor.Flush
   Exit Sub
errHand:
   Debug.Print Err.Description
End Sub