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