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