在VB中如何将Access表中点和线转换成Shape文件

计算机程序能通过使用本节的技术描述来产生，读，写shape文件。一个ESRI的shape文件包括一个主文件，一个索引文件，和一个dBASE表。主文件是一个直接存取，变量记录长度文件，其中每个记录描述一个有它自己的vertices列表的shape。在索引文件中，每个记录包含对应主文件记录离主文件头开始的偏移，dBASE表包含一feature一个记录的feature的特征。几何和属性间的一一对应关系是基于记录数目的。在dBASE文件中的属性记录必须和主文件中的记录是相同顺序的。

ESRI Shape 文件使用简单的非拓扑格式存储地理对象的位置信息和属性信息。创建Shape文件的方法有：使用ArcInfo、Spatial Database Engine、ArcView GIS等软件将数据源导出为Shape文件；使用ArcView Gis 的对象创建工具创建Shape文件；用Avenue MapObjects、Arc Macro Language (AML)在程序中动态创建Shape文件。

这里面都是一些常规的功能,但是有两种不同的方法在将数据写入Shape文件的时候有速度是完全不一样的.下面是用两种不同方法的函数.大家可以试一试!

'添加各个要素到Shape文件
Private Sub AddAllFeatures(pCursor As ICursor, pFeatureClass As IFeatureClass)
 
  Dim pLineFXName As String
  Dim pLineFYName As String
  Dim pLineTXName As String
  Dim pLineTYName As String
  Dim pLineFXIndex As Long
  Dim pLineFYIndex As Long
  Dim pLineTXIndex As Long
  Dim pLineTYIndex As Long
 
  '获得坐标字段名称
 
  Dim pGxCatalog As IGxCatalog
  Set pGxCatalog = New GxCatalog
  pGxCatalog.GetObjectFromFullName
 
  '判断坐标字段是否为空(取消之后还要删除shape文件)
  If cboXY.Item(0).Text = "" Or cboXY.Item(1).Text = "" Or cboXY.Item(2).Text = "" Or cboXY.Item(3).Text = "" Then
    Dim intXYField As Integer
    intXYField = MsgBox("请选择坐标字段!", vbOKCancel, "信息")
    If intXYField = 1 Then
      Exit Sub
    Else
      Unload frmCreateShapeFromAccess
      Exit Sub
    End If
  End If
 
  pLineFXName = cboXY.Item(0).Text
  pLineFYName = cboXY.Item(1).Text
  pLineTXName = cboXY.Item(2).Text
  pLineTYName = cboXY.Item(3).Text
 
  '获得坐标字段所对应的索引
  pLineFXIndex = pCursor.FindField(pLineFXName)
  pLineFYIndex = pCursor.FindField(pLineFYName)
  pLineTXIndex = pCursor.FindField(pLineTXName)
  pLineTYIndex = pCursor.FindField(pLineTYName)
 
  Dim pIndex(4) As Long
  pIndex(0) = pLineFXIndex
  pIndex(1) = pLineFYIndex
  pIndex(2) = pLineTXIndex
  pIndex(3) = pLineTYIndex
 
  Dim pFields As IFields
  Set pFields = pCursor.Fields
  Dim blFieldType As Boolean
  Dim pFieldType As Long
  For i = 0 To 3
    pFieldType = pCursor.Fields.Field(pIndex(i)).Type
    blFieldType = blFieldType Or (pFieldType = esriFieldTypeDouble)
  Next i
 
  If Not blFieldType Then
    Dim intFieldType As Integer
    intFieldType = MsgBox("请选择正确的坐标字段!", vbOKCancel, "信息")
    If intFieldType = 1 Then
      Exit Sub
    Else
      Unload frmCreateShapeFromAccess
      Exit Sub
    End If
   
  End If
 
  Dim pRow As IRow
  Dim pFromPoint As IPoint
  Dim pToPoint As IPoint
  Dim pPolyline As IPolyline
 
  Dim pFeature As IFeature
 
  '判断所选择的表是否为空
  If pCursor Is Nothing Then
    MsgBox "所选择的表中记录为空!", vbOKCancel, "信息"
    Exit Sub
  End If
  Set pRow = pCursor.NextRow
 
  '创建并添加各个记录
  If opPoint Then
    '创建并添加点记录
    Do While Not pRow Is Nothing
      Set pFromPoint = New Point
      If Not (IsNull(pRow.Value(pLineFXIndex)) Or IsNull(pRow.Value(pLineFYIndex))) Then
        pFromPoint.X = pRow.Value(pLineFXIndex)
        pFromPoint.Y = pRow.Value(pLineFYIndex)
       
        If pFeatureClass Is Nothing Then
          MsgBox "没有创建shape文件!", vbOKCancel, "信息"
          Exit Sub
        End If
       
        Set pFeature = pFeatureClass.CreateFeature
        Set pFeature.Shape = pFromPoint
        pFeature.Store
        Set pRow = pCursor.NextRow
      Else
        Set pRow = pCursor.NextRow
      End If
    Loop
  Else
 
    '创建并添加线记录
    Do While Not pRow Is Nothing
      Set pFromPoint = New Point
      Set pToPoint = New Point
      If Not (IsNull(pRow.Value(pLineFXIndex)) Or IsNull(pRow.Value(pLineFYIndex)) Or IsNull(pRow.Value(pLineTXIndex)) Or IsNull(pRow.Value(pLineTYIndex))) Then
        pFromPoint.X = pRow.Value(pLineFXIndex)
        pFromPoint.Y = pRow.Value(pLineFYIndex)
        pToPoint.X = pRow.Value(pLineTXIndex)
        pToPoint.Y = pRow.Value(pLineTYIndex)
       
        Set pPolyline = New Polyline
        pPolyline.FromPoint = pFromPoint
        pPolyline.ToPoint = pToPoint
       
        '判断shape文件是否创建
        If pFeatureClass Is Nothing Then
          MsgBox "没有创建shape文件!", vbOKCancel, "信息"
          Exit Sub
        End If

        Set pFeature = pFeatureClass.CreateFeature
        Set pFeature.Shape = pPolyline
        'Set pFeature.Fields = pRow.Fields
        pFeature.Store
        Set pRow = pCursor.NextRow
      Else
        Set pRow = pCursor.NextRow
      End If
    Loop
   
  End If
End Sub