Sub createrectangle()
Dim pWorkspaceFactory As IWorkspaceFactory
Set pWorkspaceFactory = New ShapefileWorkspaceFactory
Dim pFeatureWorkspace As IFeatureWorkspace
Set pFeatureWorkspace = _
pWorkspaceFactory.OpenFromFile("D:\数据\2222", 0)
Dim pFeatureClass As IFeatureClass
Set pFeatureClass = pFeatureWorkspace.OpenFeatureClass("text2")
Dim XY(8, 4, 2) As Double
XY(0, 0, 0) = 145#
XY(0, 0, 1) = 50#
XY(0, 1, 0) = 200#
XY(0, 1, 1) = 50#
XY(0, 2, 0) = 200#
XY(0, 2, 1) = 30#
XY(0, 3, 0) = 145#
XY(0, 3, 1) = 30#
XY(1, 0, 0) = 130#
XY(1, 0, 1) = 20#
XY(1, 1, 0) = 200#
XY(1, 1, 1) = 20
XY(1, 2, 0) = 200#
XY(1, 2, 1) = -20#
XY(1, 3, 0) = 130#
XY(1, 3, 1) = -20#
XY(2, 0, 0) = -150#
XY(2, 0, 1) = 10#
XY(2, 1, 0) = -80#
XY(2, 1, 1) = 10#
XY(2, 2, 0) = -80#
XY(2, 2, 1) = -20#
XY(2, 3, 0) = -150#
XY(2, 3, 1) = -20#
XY(3, 0, 0) = -140#
XY(3, 0, 1) = -20#
XY(3, 1, 0) = -75#
XY(3, 1, 1) = -20#
XY(3, 2, 0) = -75#
XY(3, 2, 1) = -50#
XY(3, 3, 0) = -140#
XY(3, 3, 1) = -50#
XY(4, 0, 0) = -70#
XY(4, 0, 1) = -25#
XY(4, 1, 0) = -40#
XY(4, 1, 1) = -25#
XY(4, 2, 0) = -40#
XY(4, 2, 1) = -55#
XY(4, 3, 0) = -70#
XY(4, 3, 1) = -55#
XY(5, 0, 0) = -50#
XY(5, 0, 1) = 30#
XY(5, 1, 0) = 0#
XY(5, 1, 1) = 30#
XY(5, 2, 0) = 0#
XY(5, 2, 1) = -30#
XY(5, 3, 0) = -50#
XY(5, 3, 1) = -30#
XY(6, 0, 0) = 40#
XY(6, 0, 1) = 15#
XY(6, 1, 0) = 95#
XY(6, 1, 1) = 15#
XY(6, 2, 0) = 95#
XY(6, 2, 1) = -15#
XY(6, 3, 0) = 40#
XY(6, 3, 1) = -15#
XY(7, 0, 0) = 105#
XY(7, 0, 1) = 50#
XY(7, 1, 0) = 145#
XY(7, 1, 1) = 50#
XY(7, 2, 0) = 145#
XY(7, 2, 1) = 10#
XY(7, 3, 0) = 105#
XY(7, 3, 1) = 10#
Dim pColl As IPointCollection4
Dim pPoint As IPoint
Dim pPoly As IPolygon4
For i = 0 To 7
Set pColl = New Polygon
For j = 0 To 3
Set pPoint = New Point
pPoint.PutCoords XY(i, j, 0), XY(i, j, 1)
pColl.AddPoint pPoint
Next j
Set pPoly = pColl
pPoly.Close
Dim pFeature As IFeature
Set pFeature = pFeatureClass.CreateFeature
Set pFeature.Shape = pPoly
pFeature.Store
Next i
End Sub
