vba 生成点的矩形buffer

Private Sub CommandButton1_Click()

Dim pMxDoc As IMxDocument
Set pMxDoc = Application.Document

Dim pMap As IMap
Set pMap = pMxDoc.FocusMap

Dim pActiveView As IActiveView
Set pActiveView = pMxDoc.FocusMap

Dim pFeatureClass As IFeatureClass
Dim pFLayer As IFeatureLayer
Set pFLayer = pMap.Layer(0)
Set pFeatureClass = pFLayer.FeatureClass
Dim pFeatureCursor As IFeatureCursor
Set pFeatureCursor = pFeatureClass.Search(Nothing, True)

Dim totalcount As Integer
totalcount = pFeatureClass.FeatureCount(Nothing)


Dim pFeature As IFeature
Set pFeature = pFeatureCursor.NextFeature

Dim xmax As Double
Dim ymax As Double
Dim xmin As Double
Dim ymin As Double


Dim pPoint As IPoint
Dim pPolygon As IPolygon
Dim pArea As IArea
Dim pNewPolygon As IPolygon
Dim pNewPoints As IPointCollection
Dim pNewPoint As IPoint


Dim count As Integer
count = 0

Dim xdistance As Double
xdistance = CDbl(TextBox1.Text)
Dim ydistance As Double
ydistance = CDbl(TextBox2.Text)

 
While Not pFeature Is Nothing
  
   Set pPolygon = pFeature.Shape
   Set pArea = pPolygon
   Set pPoint = pArea.Centroid
  

   xmax = pPoint.X + xdistance
   ymax = pPoint.Y + ydistance
   xmin = pPoint.X - xdistance
   ymin = pPoint.Y - ydistance
  
   Set pNewPoints = New Polygon
  
   Set pNewPoint = New Point
   pNewPoint.X = xmin
   pNewPoint.Y = ymax
   pNewPoints.AddPoint pNewPoint
  
    Set pNewPoint = New Point
   pNewPoint.X = xmax
   pNewPoint.Y = ymax
   pNewPoints.AddPoint pNewPoint
  
   Set pNewPoint = New Point
   pNewPoint.X = xmax
   pNewPoint.Y = ymin
   pNewPoints.AddPoint pNewPoint

   Set pNewPoint = New Point
   pNewPoint.X = xmin
   pNewPoint.Y = ymin
   pNewPoints.AddPoint pNewPoint

  
   Set pNewPolygon = pNewPoints
   pNewPolygon.Close
  
   Set pFeature.Shape = pNewPolygon
   pFeature.Store
  
 
   Set pFeature = pFeatureCursor.NextFeature
  
   count = count + 1
  
  Label1.Caption = "第" & count & "个" & " / " & "共计：" & totalcount
 
  UserForm1.Repaint

Wend

  MsgBox "done!"
End Sub
————————————————————————————————————————————————————

Sub point2polygon()

UserForm1.Show

End Sub