之前的文章提到创建各类createworkspace的方法（源于esri网站），里面有个特别的接口是InMemeryWorkspace，即内存GeoDatabase模型对象，主要是用于提高效率的，那今天就写一下创建要素（创建100000个点对象，相同坐标）的效率差异
基于文件的用Persoanl GeoDatabase格式，即mdb
测试环境：cpu－pentium M 1.5G，内存－1G，硬盘－5400转
开发环境：vba
下面提供完成测试代码及测试结果
'创建基于文件的要素类及数据
Public Sub CreateFilePolygonFeatureClass()
Dim pworkspaceFactory As IWorkspaceFactory
Set pworkspaceFactory = New AccessWorkspaceFactory
Dim pworkspace As IWorkspace
Set pworkspace = pworkspaceFactory.OpenFromFile("c:\test.mdb", 0)
Dim pFeatureWorkspace As IFeatureWorkspace
Set pFeatureWorkspace = pworkspace
Dim pFeatureClass As IFeatureClass
Set pFeatureClass = createWorkspaceFeatureClass(pFeatureWorkspace, "testlayer", esriFTSimple, esriGeometryPoint)
Dim pFeatureCursor As IFeatureCursor
Dim pFeature As IFeature
Dim pFeatureBuffer As IFeatureBuffer
Set pFeatureCursor = pFeatureClass.Insert(True)
Set pFeatureBuffer = pFeatureClass.CreateFeatureBuffer
Dim i As Long
Dim pPoint As IPoint
Dim l As Long
Debug.Print Now
For i = 1 To 100000
Set pPoint = New Point
pPoint.PutCoords 100, 200
Set pFeatureBuffer.Shape = pPoint
pFeatureCursor.InsertFeature pFeatureBuffer
l = l + 1
If l Mod 1000 = 0 Then
pFeatureCursor.Flush
End If
Set pPoint = Nothing
Next i
pFeatureCursor.Flush
Debug.Print Now
Dim pmxdoc As IMxDocument
Set pmxdoc = ThisDocument
Dim pmap As IMap
Set pmap = pmxdoc.FocusMap
Dim pfeaturelayer As IFeatureLayer
Set pfeaturelayer = New FeatureLayer
Set pfeaturelayer.FeatureClass = pFeatureClass
pmap.AddLayer pfeaturelayer
End Sub
Public Sub CreateFilePolygonFeatureClass()
Dim pworkspaceFactory As IWorkspaceFactory
Set pworkspaceFactory = New AccessWorkspaceFactory
Dim pworkspace As IWorkspace
Set pworkspace = pworkspaceFactory.OpenFromFile("c:\test.mdb", 0)
Dim pFeatureWorkspace As IFeatureWorkspace
Set pFeatureWorkspace = pworkspace
Dim pFeatureClass As IFeatureClass
Set pFeatureClass = createWorkspaceFeatureClass(pFeatureWorkspace, "testlayer", esriFTSimple, esriGeometryPoint)
Dim pFeatureCursor As IFeatureCursor
Dim pFeature As IFeature
Dim pFeatureBuffer As IFeatureBuffer
Set pFeatureCursor = pFeatureClass.Insert(True)
Set pFeatureBuffer = pFeatureClass.CreateFeatureBuffer
Dim i As Long
Dim pPoint As IPoint
Dim l As Long
Debug.Print Now
For i = 1 To 100000
Set pPoint = New Point
pPoint.PutCoords 100, 200
Set pFeatureBuffer.Shape = pPoint
pFeatureCursor.InsertFeature pFeatureBuffer
l = l + 1
If l Mod 1000 = 0 Then
pFeatureCursor.Flush
End If
Set pPoint = Nothing
Next i
pFeatureCursor.Flush
Debug.Print Now
Dim pmxdoc As IMxDocument
Set pmxdoc = ThisDocument
Dim pmap As IMap
Set pmap = pmxdoc.FocusMap
Dim pfeaturelayer As IFeatureLayer
Set pfeaturelayer = New FeatureLayer
Set pfeaturelayer.FeatureClass = pFeatureClass
pmap.AddLayer pfeaturelayer
End Sub
'创建基于内存的要素类及数据
Public Sub CreateMemeryPolygonFeatureClass()
Dim pworkspaceFactory As IWorkspaceFactory
Set pworkspaceFactory = New AccessWorkspaceFactory
Dim pworkspace As IWorkspace
Set pworkspace = CreateInMemoryWorkspace
Dim pFeatureWorkspace As IFeatureWorkspace
Set pFeatureWorkspace = pworkspace
Dim pFeatureClass As IFeatureClass
Set pFeatureClass = createWorkspaceFeatureClass(pFeatureWorkspace, "testlayer", esriFTSimple, esriGeometryPoint)
Dim pFeatureCursor As IFeatureCursor
Dim pFeature As IFeature
Dim pFeatureBuffer As IFeatureBuffer
Set pFeatureCursor = pFeatureClass.Insert(True)
Set pFeatureBuffer = pFeatureClass.CreateFeatureBuffer
Dim i As Long
Dim pPoint As IPoint
Dim l As Long
Debug.Print Now
For i = 1 To 100000
Set pPoint = New Point
pPoint.PutCoords 100, 200
Set pFeatureBuffer.Shape = pPoint
pFeatureCursor.InsertFeature pFeatureBuffer
l = l + 1
If l Mod 1000 = 0 Then
pFeatureCursor.Flush
End If
Set pPoint = Nothing
Next i
pFeatureCursor.Flush
Debug.Print Now
Dim pmxdoc As IMxDocument
Set pmxdoc = ThisDocument
Dim pmap As IMap
Set pmap = pmxdoc.FocusMap
Dim pfeaturelayer As IFeatureLayer
Set pfeaturelayer = New FeatureLayer
Set pfeaturelayer.FeatureClass = pFeatureClass
pmap.AddLayer pfeaturelayer
Public Sub CreateMemeryPolygonFeatureClass()
Dim pworkspaceFactory As IWorkspaceFactory
Set pworkspaceFactory = New AccessWorkspaceFactory
Dim pworkspace As IWorkspace
Set pworkspace = CreateInMemoryWorkspace
Dim pFeatureWorkspace As IFeatureWorkspace
Set pFeatureWorkspace = pworkspace
Dim pFeatureClass As IFeatureClass
Set pFeatureClass = createWorkspaceFeatureClass(pFeatureWorkspace, "testlayer", esriFTSimple, esriGeometryPoint)
Dim pFeatureCursor As IFeatureCursor
Dim pFeature As IFeature
Dim pFeatureBuffer As IFeatureBuffer
Set pFeatureCursor = pFeatureClass.Insert(True)
Set pFeatureBuffer = pFeatureClass.CreateFeatureBuffer
Dim i As Long
Dim pPoint As IPoint
Dim l As Long
Debug.Print Now
For i = 1 To 100000
Set pPoint = New Point
pPoint.PutCoords 100, 200
Set pFeatureBuffer.Shape = pPoint
pFeatureCursor.InsertFeature pFeatureBuffer
l = l + 1
If l Mod 1000 = 0 Then
pFeatureCursor.Flush
End If
Set pPoint = Nothing
Next i
pFeatureCursor.Flush
Debug.Print Now
Dim pmxdoc As IMxDocument
Set pmxdoc = ThisDocument
Dim pmap As IMap
Set pmap = pmxdoc.FocusMap
Dim pfeaturelayer As IFeatureLayer
Set pfeaturelayer = New FeatureLayer
Set pfeaturelayer.FeatureClass = pFeatureClass
pmap.AddLayer pfeaturelayer
End Sub
'创建内存工作空间对象
Public Function CreateInMemoryWorkspace() As IWorkspace
Dim pworkspaceFactory As IWorkspaceFactory
Set pworkspaceFactory = New InMemoryWorkspaceFactory
Dim pworkspaceName As IWorkspaceName
Set pworkspaceName = pworkspaceFactory.Create("", "MyWorkspace", Nothing, 0)
Dim pName As IName
Set pName = pworkspaceName
Dim pworkspace As IWorkspace
Set pworkspace = pName.Open()
Set CreateInMemoryWorkspace = pworkspace
End Function
Dim pworkspaceFactory As IWorkspaceFactory
Set pworkspaceFactory = New InMemoryWorkspaceFactory
Dim pworkspaceName As IWorkspaceName
Set pworkspaceName = pworkspaceFactory.Create("", "MyWorkspace", Nothing, 0)
Dim pName As IName
Set pName = pworkspaceName
Dim pworkspace As IWorkspace
Set pworkspace = pName.Open()
Set CreateInMemoryWorkspace = pworkspace
End Function
'创建要素类
Public Function createWorkspaceFeatureClass(featWorkspace As IFeatureWorkspace, _
Name As String, _
featType As esriFeatureType, _
Optional geomType As esriGeometryType = esriGeometryPoint, _
Optional pfields As IFields, _
Optional pCLSID As UID, _
Optional pCLSEXT As UID, _
Optional ConfigWord As String = "" _
) As IFeatureClass
On Error GoTo EH
Set createWorkspaceFeatureClass = Nothing
If featWorkspace Is Nothing Then Exit Function
If Name = "" Then Exit Function
If (pCLSID Is Nothing) Or IsMissing(pCLSID) Then
Set pCLSID = Nothing
Set pCLSID = New UID
Select Case featType
Case esriFTSimple
pCLSID.Value = "esriGeoDatabase.Feature"
If geomType = esriGeometryLine Then geomType = esriGeometryPolyline
Case esriFTSimpleJunction
geomType = esriGeometryPoint
pCLSID.Value = "esriGeoDatabase.SimpleJunctionFeature"
Case esriFTComplexJunction
pCLSID.Value = "esriGeoDatabase.ComplexJunctionFeature"
Case esriFTSimpleEdge
geomType = esriGeometryPolyline
pCLSID.Value = "esriGeoDatabase.SimpleEdgeFeature"
Case esriFTComplexEdge
geomType = esriGeometryPolyline
pCLSID.Value = "esriGeoDatabase.ComplexEdgeFeature"
Case esriFTAnnotation
Exit Function
End Select
End If
If (pfields Is Nothing) Or IsMissing(pfields) Then
Dim pFieldsEdit As IFieldsEdit
Set pFieldsEdit = New Fields
Dim pGeomDef As IGeometryDef
Set pGeomDef = New GeometryDef
Dim pGeomDefEdit As IGeometryDefEdit
Set pGeomDefEdit = pGeomDef
Dim pSR As ISpatialReference
Set pSR = New UnknownCoordinateSystem
pSR.SetDomain 0, 21474.83645, 0, 21474.83645
pSR.SetFalseOriginAndUnits 0, 0, 100000
With pGeomDefEdit
.GeometryType = geomType
.GridCount = 1
.GridSize(0) = 10
.AvgNumPoints = 2
.HasM = False
.HasZ = False
Set .SpatialReference = pSR
End With
Dim pField As IField
Dim pFieldEdit As IFieldEdit
Set pField = New Field
Set pFieldEdit = pField
pFieldEdit.Name = "SHAPE"
pFieldEdit.AliasName = "GEOMETRY"
pFieldEdit.Type = esriFieldTypeGeometry
Set pFieldEdit.GeometryDef = pGeomDef
pFieldsEdit.AddField pField
Set pField = New Field
Set pFieldEdit = pField
pFieldEdit.Name = "OBJECTID"
pFieldEdit.AliasName = "object identifier"
pFieldEdit.Type = esriFieldTypeOID
pFieldsEdit.AddField pField
Name As String, _
featType As esriFeatureType, _
Optional geomType As esriGeometryType = esriGeometryPoint, _
Optional pfields As IFields, _
Optional pCLSID As UID, _
Optional pCLSEXT As UID, _
Optional ConfigWord As String = "" _
) As IFeatureClass
On Error GoTo EH
Set createWorkspaceFeatureClass = Nothing
If featWorkspace Is Nothing Then Exit Function
If Name = "" Then Exit Function
If (pCLSID Is Nothing) Or IsMissing(pCLSID) Then
Set pCLSID = Nothing
Set pCLSID = New UID
Select Case featType
Case esriFTSimple
pCLSID.Value = "esriGeoDatabase.Feature"
If geomType = esriGeometryLine Then geomType = esriGeometryPolyline
Case esriFTSimpleJunction
geomType = esriGeometryPoint
pCLSID.Value = "esriGeoDatabase.SimpleJunctionFeature"
Case esriFTComplexJunction
pCLSID.Value = "esriGeoDatabase.ComplexJunctionFeature"
Case esriFTSimpleEdge
geomType = esriGeometryPolyline
pCLSID.Value = "esriGeoDatabase.SimpleEdgeFeature"
Case esriFTComplexEdge
geomType = esriGeometryPolyline
pCLSID.Value = "esriGeoDatabase.ComplexEdgeFeature"
Case esriFTAnnotation
Exit Function
End Select
End If
If (pfields Is Nothing) Or IsMissing(pfields) Then
Dim pFieldsEdit As IFieldsEdit
Set pFieldsEdit = New Fields
Dim pGeomDef As IGeometryDef
Set pGeomDef = New GeometryDef
Dim pGeomDefEdit As IGeometryDefEdit
Set pGeomDefEdit = pGeomDef
Dim pSR As ISpatialReference
Set pSR = New UnknownCoordinateSystem
pSR.SetDomain 0, 21474.83645, 0, 21474.83645
pSR.SetFalseOriginAndUnits 0, 0, 100000
With pGeomDefEdit
.GeometryType = geomType
.GridCount = 1
.GridSize(0) = 10
.AvgNumPoints = 2
.HasM = False
.HasZ = False
Set .SpatialReference = pSR
End With
Dim pField As IField
Dim pFieldEdit As IFieldEdit
Set pField = New Field
Set pFieldEdit = pField
pFieldEdit.Name = "SHAPE"
pFieldEdit.AliasName = "GEOMETRY"
pFieldEdit.Type = esriFieldTypeGeometry
Set pFieldEdit.GeometryDef = pGeomDef
pFieldsEdit.AddField pField
Set pField = New Field
Set pFieldEdit = pField
pFieldEdit.Name = "OBJECTID"
pFieldEdit.AliasName = "object identifier"
pFieldEdit.Type = esriFieldTypeOID
pFieldsEdit.AddField pField
Set pfields = pFieldsEdit
End If
If (pCLSEXT Is Nothing) Or IsMissing(pCLSEXT) Then
Set pCLSEXT = Nothing
End If
Dim strShapeFld As String
Dim j As Integer
For j = 0 To pfields.FieldCount - 1
If pfields.Field(j).Type = esriFieldTypeGeometry Then
strShapeFld = pfields.Field(j).Name
End If
Next
Set createWorkspaceFeatureClass = featWorkspace.CreateFeatureClass(Name, pfields, pCLSID, _
pCLSEXT, featType, strShapeFld, ConfigWord)
Exit Function
EH:
MsgBox Err.Description, vbInformation, "createWorkspaceFeatureClass"
End Function
End If
If (pCLSEXT Is Nothing) Or IsMissing(pCLSEXT) Then
Set pCLSEXT = Nothing
End If
Dim strShapeFld As String
Dim j As Integer
For j = 0 To pfields.FieldCount - 1
If pfields.Field(j).Type = esriFieldTypeGeometry Then
strShapeFld = pfields.Field(j).Name
End If
Next
Set createWorkspaceFeatureClass = featWorkspace.CreateFeatureClass(Name, pfields, pCLSID, _
pCLSEXT, featType, strShapeFld, ConfigWord)
Exit Function
EH:
MsgBox Err.Description, vbInformation, "createWorkspaceFeatureClass"
End Function
结果：基于文件的耗时为24秒（输出文件大小为25M），基于内存的耗时为0.3秒。我想主要的差异来自于写磁盘，如果磁盘的转速提高，应该写入文件的速度会提高，服务器硬盘有15000转的了，可以提高2倍，但仍不如基于内存的
还有个简单的地方可以看出两者差异，就是在arcmap打开属性表，移动到最后一条记录，用内存方式的速度要比文件方式的快些，但优势不明显，不过数据量和属性字段增加后优势会比较明显
因为基于内存的数据模型的使用与基于文件数据模型的使用没有差别，所以在处理大数据量、大循环或复杂的空间搜索时，建议使用内存数据模型