arcEngine classic code(2)

1 新建shp文件
Public Sub CreatShapeFile(ByVal sFilePath As String, ByVal sFileName As String)     '创建shapefile层文件
On Error GoTo Errhandle:
    Dim pWorkspaceFactory As IWorkspaceFactory
    Dim pFeatureWorkspace As IFeatureWorkspace
    Dim pFields As IFields
    Dim pFieldsEdit As IFieldsEdit
    Dim pField As IField
    Dim pFieldEdit As IFieldEdit
    Dim pGeometryDef As IGeometryDef
    Dim pGeometryDefEdit As IGeometryDefEdit
    Dim pFeatClass As IFeatureClass
    Dim sShapeFieldName As String
    Dim sNewShapeFileName As String

    sNewShapeFileName = Dir(sFilePath & "\" & sFileName & ".shp")
    If (sNewShapeFileName <> "") Then
             MsgBox ("文件已经存在")
        Exit Sub
    End If
    sShapeFieldName = "Shape"                                '先创建一个字段名字
    '创建一个文件夹来存放shapefile文件
    Set pWorkspaceFactory = New ShapefileWorkspaceFactory
    Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile(sFilePath, 0)
   
    'Set up a simple fields collection
    Set pFields = New esriGeoDatabase.Fields
    Set pFieldsEdit = pFields
    'Make the shape field
    'it will need a geometry definition, with a spatial reference
    Set pField = New esriGeoDatabase.Field
    Set pFieldEdit = pField
    '创建第一个字段
    pFieldEdit.Name = sShapeFieldName
    pFieldEdit.Type = esriFieldTypeGeometry
    Set pGeometryDef = New GeometryDef
    Set pGeometryDefEdit = pGeometryDef
    With pGeometryDefEdit
    .GeometryType = esriGeometryPolygon
    Set .SpatialReference = New UnknownCoordinateSystem
    End With
    Set pFieldEdit.GeometryDef = pGeometryDef
    pFieldsEdit.AddField pField               '添加字段到字段集中
    '再添加一个字段
    Set pField = New esriGeoDatabase.Field
    Set pFieldEdit = pField
    With pFieldEdit
        .Name = "type"
        .Type = esriFieldTypeString
    End With
    pFieldsEdit.AddField pField               '添加字段到字段集中
    '开始创建shapefile层文件
    '(some parameters apply to geodatabase options and can be defaulted as Nothing)
    Set pFeatClass = pFeatureWorkspace.CreateFeatureClass _
    (sFileName, pFields, Nothing, Nothing, _
    esriFTSimple, sShapeFieldName, "")
'    sNewShapeFileName = Dir(sFilePath & "\" & sFileName & ".shp")
'      If (sNewShapeFileName = "") Then
'        MsgBox ("Build Fail")
'    Else
'        MsgBox ("Build Success")
'    End If
Errhandle:
    Set pFeatClass = Nothing
    Set pGeometryDefEdit = Nothing
    Set pGeometryDef = Nothing
    Set pFieldEdit = Nothing
    Set pField = Nothing
    Set pFieldsEdit = Nothing
    Set pFields = Nothing
    Set pFeatureWorkspace = Nothing
    Set pWorkspaceFactory = Nothing

    If Err.Description <> "" Then
    MsgBox Err.Description & "：创建shapefile失败！", vbInformation, "提示信息"
    End If
End Sub