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
本文转自wenglabs博客园博客，原文链接：http://www.cnblogs.com/xiexiaokui/archive/2008/05/11/1192358.html，如需转载请自行联系原作者
