|
Private Sub CreatShapeFile(ByVal sFilePath As String, ByVal sFileName As String)
Dim pFeatureWorkspace As IFeatureWorkspace
Dim pWorkspaceFactory As IWorkspaceFactory
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
On Error GoTo ErrorHandler:
sNewShapeFileName = Dir(sFilePath & sFileName & ".shp")
If (sNewShapeFileName <> "") Then
MsgBox ("文件已经存在")
Exit Sub
End If
sShapeFieldName = "Shape"
'Open the folder to contain the shapefile as a workspace
Set pWorkspaceFactory = New ShapefileWorkspaceFactory
Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile(sFilePath, 0)
'Set up a simple fields collection
Set pFields = New esriCore.Fields
Set pFieldsEdit = pFields
'Make the shape field
'it will need a geometry definition, with a spatial reference
Set pField = New esriCore.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
'Add others miscellaneous text field
Set pField = New esriCore.Field
Set pFieldEdit = pField
With pFieldEdit
.Name = "SmallInteger"
.Type = esriFieldTypeSmallInteger
End With
pFieldsEdit.AddField pField
Set pField = New esriCore.Field
Set pFieldEdit = pField
With pFieldEdit
.Name = "Integer"
.Type = esriFieldTypeInteger
End With
pFieldsEdit.AddField pField
Set pField = New esriCore.Field
Set pFieldEdit = pField
With pFieldEdit
.Name = "Single"
.Type = esriFieldTypeSingle
End With
pFieldsEdit.AddField pField
Set pField = New esriCore.Field
Set pFieldEdit = pField
With pFieldEdit
.Precision = 5
.Scale = 5
.Name = "Double"
.Type = esriFieldTypeDouble
End With
pFieldsEdit.AddField pField
Set pField = New esriCore.Field
Set pFieldEdit = pField
With pFieldEdit
.Length = 30
.Name = "String"
.Type = esriFieldTypeString
End With
pFieldsEdit.AddField pField
Set pField = New esriCore.Field
Set pFieldEdit = pField
With pFieldEdit
.Name = "Date"
.Type = esriFieldTypeDate
End With
pFieldsEdit.AddField pField
'Create the 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 & "\MyShapeFile.shp")
If (sNewShapeFileName = "") Then
MsgBox ("Build Success")
Else
MsgBox ("Build Fail")
End If
Exit Sub
ErrorHandler:
MsgBox Err.Description
End Sub
Private Sub UIButtonControl1_Click()
Dim pVBProject As VBProject
On Error GoTo ErrorHandler:
Set pVBProject = ThisDocument.VBProject
'Dont include .shp extension
CreatShapeFile pVBProject.FileName & "\..\..\..\.." & "\data\", "MyShapeFile"
Exit Sub
ErrorHandler:
MsgBox Err.Description
End Sub
Private Sub UIButtonControl1_Click()
Dim pVBProject As VBProject
On Error GoTo ErrorHandler:
Set pVBProject = ThisDocument.VBProject
'Dont include .shp extension
CreatShapeFile pVBProject.FileName & "\..\..\..\.." & "\data\", "MyShapeFile"
Exit Sub
ErrorHandler:
MsgBox Err.Description
End Sub
|
