Draw a circle from the centroid of a polygon and divide the circle into four segments

ManjubaashiniRaghunath

I'm trying to write a code to draw a circle (buffer) from the centroid of a polygon,and then divide the circle into four segments.Give each segment a different color.

KingsleyPayne

Here, try this.

Sub CentroidQuadrants()

' Buffers the centroid of a polygon and divides the resulting circle into 4 even-sized quadrants
' creating a separate polygon feature for each quadrant of the circle.

Dim pMxd As IMxDocument
Set pMxd = ThisDocument

Dim pUID As UID
Set pUID = New UID
pUID.Value = "esriEditor.Editor"

Dim pEditor As IEditor
Set pEditor = Application.FindExtensionByCLSID(pUID)

If (pEditor Is Nothing) Then
    MsgBox "Failed to get a reference to the ArcMap Editor!"
    Exit Sub
End If

Dim pEnumFeature As IEnumFeature
Set pEnumFeature = pMxd.FocusMap.FeatureSelection

pEnumFeature.Reset

Dim pSearchFeature As IFeature
Set pSearchFeature = pEnumFeature.Next

If (pSearchFeature Is Nothing) Then
    MsgBox "Please select a feature!"
    Exit Sub
End If

Dim pLayer As ILayer
Dim pFeatureLayer As IFeatureLayer

Dim i As Integer

For i = 0 To pMxd.FocusMap.LayerCount - 1
    Set pLayer = pMxd.FocusMap.Layer(i)
    
    If pLayer.Name = "Land Parcel SG Approved (Land Parcel)" Then
        Set pFeatureLayer = pLayer
        Exit For
    End If
Next

If (pFeatureLayer Is Nothing) Then
    MsgBox "Land Parcel layer not found!"
    Exit Sub
End If

Dim pDataset As IDataset
Set pDataset = pFeatureLayer.FeatureClass

pEditor.StartEditing pDataset.Workspace

' If this macro fails even once, the Editor will become bedwangled.
' When this happens, uncomment the StopOperation() below to keep moving.
' pEditor.StopOperation "Create circle quadrants"

pEditor.StartOperation

Dim pArea As IArea
Set pArea = pSearchFeature.Shape

Dim pCentroid As IPoint
Set pCentroid = pArea.Centroid

Dim pTopoOp As ITopologicalOperator
Set pTopoOp = pCentroid

Dim pBufferedPoint As IGeometry
Set pBufferedPoint = pTopoOp.Buffer(100)

Dim pFeature As IFeature

' This stores the original circle from the buffered centroid
' Set pFeature = pFeatureLayer.FeatureClass.CreateFeature
' Set pFeature.Shape = pBufferedPoint
' pFeature.Store

Dim pCircleEnvelope As IEnvelope
Set pCircleEnvelope = pBufferedPoint.Envelope

Dim pEnv As IEnvelope
Dim pPointCollection As IPointCollection

' LOWER LEFT

Set pEnv = New Envelope
Set pEnv.SpatialReference = pCentroid.SpatialReference

pEnv.PutCoords pCircleEnvelope.LowerLeft.X, pCircleEnvelope.LowerLeft.Y, pCircleEnvelope.LowerRight.X - (pCircleEnvelope.Width / 2), pCircleEnvelope.UpperLeft.Y - (pCircleEnvelope.Height / 2)

Dim pQuadrantPoly As IPolygon
Set pQuadrantPoly = New Polygon
Set pQuadrantPoly.SpatialReference = pCentroid.SpatialReference
Set pPointCollection = pQuadrantPoly

Dim pLLPoint As IPoint
Dim pULPoint As IPoint
Dim pURPoint As IPoint
Dim pLRPoint As IPoint

Set pLLPoint = New Point
Set pULPoint = New Point
Set pURPoint = New Point
Set pLRPoint = New Point

pLLPoint.PutCoords pEnv.LowerLeft.X, pEnv.LowerLeft.Y
pULPoint.PutCoords pEnv.UpperLeft.X, pEnv.UpperLeft.Y
pURPoint.PutCoords pEnv.UpperRight.X, pEnv.UpperRight.Y
pLRPoint.PutCoords pEnv.LowerRight.X, pEnv.LowerRight.Y

pPointCollection.AddPoint pLLPoint
pPointCollection.AddPoint pULPoint
pPointCollection.AddPoint pURPoint
pPointCollection.AddPoint pLRPoint

pQuadrantPoly.Close
pQuadrantPoly.SimplifyPreserveFromTo

If pQuadrantPoly.IsEmpty Then
    MsgBox "Failed to create lower left quadrant!"
End If

Set pFeature = pFeatureLayer.FeatureClass.CreateFeature
Set pTopoOp = pQuadrantPoly

Set pFeature.Shape = pTopoOp.Intersect(pBufferedPoint, esriGeometry2Dimension)
pFeature.Store

' LOWER RIGHT

Set pEnv = New Envelope
Set pEnv.SpatialReference = pCentroid.SpatialReference

pEnv.PutCoords pCircleEnvelope.LowerRight.X - (pCircleEnvelope.Width / 2), pCircleEnvelope.LowerLeft.Y, pCircleEnvelope.LowerRight.X, pCircleEnvelope.UpperLeft.Y - (pCircleEnvelope.Height / 2)

Set pQuadrantPoly = New Polygon
Set pQuadrantPoly.SpatialReference = pCentroid.SpatialReference
Set pPointCollection = pQuadrantPoly

Set pLLPoint = New Point
Set pULPoint = New Point
Set pURPoint = New Point
Set pLRPoint = New Point

pLLPoint.PutCoords pEnv.LowerLeft.X, pEnv.LowerLeft.Y
pULPoint.PutCoords pEnv.UpperLeft.X, pEnv.UpperLeft.Y
pURPoint.PutCoords pEnv.UpperRight.X, pEnv.UpperRight.Y
pLRPoint.PutCoords pEnv.LowerRight.X, pEnv.LowerRight.Y

pPointCollection.AddPoint pLLPoint
pPointCollection.AddPoint pULPoint
pPointCollection.AddPoint pURPoint
pPointCollection.AddPoint pLRPoint

pQuadrantPoly.Close
pQuadrantPoly.SimplifyPreserveFromTo

If pQuadrantPoly.IsEmpty Then
    MsgBox "Failed to create lower right polygon!"
End If

Set pFeature = pFeatureLayer.FeatureClass.CreateFeature
Set pTopoOp = pQuadrantPoly

Set pFeature.Shape = pTopoOp.Intersect(pBufferedPoint, esriGeometry2Dimension)
pFeature.Store

' UPPER LEFT

Set pEnv = New Envelope
Set pEnv.SpatialReference = pCentroid.SpatialReference

pEnv.PutCoords pCircleEnvelope.LowerLeft.X, pCircleEnvelope.UpperLeft.Y - (pCircleEnvelope.Height / 2), pCircleEnvelope.LowerRight.X - (pCircleEnvelope.Width / 2), pCircleEnvelope.UpperLeft.Y

Set pQuadrantPoly = New Polygon
Set pQuadrantPoly.SpatialReference = pCentroid.SpatialReference
Set pPointCollection = pQuadrantPoly

Set pLLPoint = New Point
Set pULPoint = New Point
Set pURPoint = New Point
Set pLRPoint = New Point

pLLPoint.PutCoords pEnv.LowerLeft.X, pEnv.LowerLeft.Y
pULPoint.PutCoords pEnv.UpperLeft.X, pEnv.UpperLeft.Y
pURPoint.PutCoords pEnv.UpperRight.X, pEnv.UpperRight.Y
pLRPoint.PutCoords pEnv.LowerRight.X, pEnv.LowerRight.Y

pPointCollection.AddPoint pLLPoint
pPointCollection.AddPoint pULPoint
pPointCollection.AddPoint pURPoint
pPointCollection.AddPoint pLRPoint

pQuadrantPoly.Close
pQuadrantPoly.SimplifyPreserveFromTo

If pQuadrantPoly.IsEmpty Then
    MsgBox "Failed to create upper left polygon!"
End If

Set pFeature = pFeatureLayer.FeatureClass.CreateFeature
Set pTopoOp = pQuadrantPoly

Set pFeature.Shape = pTopoOp.Intersect(pBufferedPoint, esriGeometry2Dimension)
pFeature.Store

' UPPER RIGHT

Set pEnv = New Envelope
Set pEnv.SpatialReference = pCentroid.SpatialReference

pEnv.PutCoords pCircleEnvelope.LowerRight.X - (pCircleEnvelope.Width / 2), pCircleEnvelope.UpperLeft.Y - (pCircleEnvelope.Height / 2), pCircleEnvelope.LowerRight.X, pCircleEnvelope.UpperLeft.Y

Set pQuadrantPoly = New Polygon
Set pQuadrantPoly.SpatialReference = pCentroid.SpatialReference
Set pPointCollection = pQuadrantPoly

Set pLLPoint = New Point
Set pULPoint = New Point
Set pURPoint = New Point
Set pLRPoint = New Point

pLLPoint.PutCoords pEnv.LowerLeft.X, pEnv.LowerLeft.Y
pULPoint.PutCoords pEnv.UpperLeft.X, pEnv.UpperLeft.Y
pURPoint.PutCoords pEnv.UpperRight.X, pEnv.UpperRight.Y
pLRPoint.PutCoords pEnv.LowerRight.X, pEnv.LowerRight.Y

pPointCollection.AddPoint pLLPoint
pPointCollection.AddPoint pULPoint
pPointCollection.AddPoint pURPoint
pPointCollection.AddPoint pLRPoint

pQuadrantPoly.Close
pQuadrantPoly.SimplifyPreserveFromTo

If pQuadrantPoly.IsEmpty Then
    MsgBox "Failed to create upper right polygon!"
End If

Set pFeature = pFeatureLayer.FeatureClass.CreateFeature
Set pTopoOp = pQuadrantPoly

Set pFeature.Shape = pTopoOp.Intersect(pBufferedPoint, esriGeometry2Dimension)
pFeature.Store

' ...... all quadrants created ......

pEditor.StopOperation "Create circle quadrants"
pEditor.StopEditing True

Dim pActiveView As IActiveView
Set pActiveView = pMxd.FocusMap
pActiveView.Refresh

End Sub