请教高手,关于mo

这是一个创建shape文件的程序，程序需要一个form，一个map，一个commondialog
通过在map上画多边形,并把他保存为shape文件，

但是当你反复运行几次程序的时候,程序偶尔会出现下面的错误(如果你运行的时候没有这
样的错误,请再运行几次,一般都会有这样的错误)



实时错误 '-2147417848 (800101108)':

对象 'trackpolygon'的方法 '_DMap'失败


Option Explicit



Dim moSymbol As New MapObjects2.Symbol

Dim moPolygons As New Collection



Private Sub Command1_Click()

  Dim gds As MapObjects2.GeoDataset

  Dim sName As String

  Dim Desc As New TableDesc

  Dim dc As New DataConnection

  Dim Lyr As New MapObjects2.MapLayer

  Dim lPoly As Long

  

  If moPolygons.Count < 1 Then

    MsgBox "先在地图上画多边形"

    Exit Sub

  End If

  

  With CommonDialog1

    .Filter = "ESRI Shapefiles (*.shp)|*.shp"

    .DefaultExt = ".shp"

    .ShowSave



    If Len(.FileName) = 0 Then Exit Sub

    dc.Database = CurDir

    If Not dc.Connect Then Exit Sub

    

    '取掉扩展名；

    sName = Left(.FileTitle, Len(.FileTitle) - 4)

  End With

  MsgBox sName



  With Desc

    .FieldCount = 3



    '设置字段名；

    .FieldName(0) = "Name"

    .FieldName(1) = "Area"

    .FieldName(2) = "Perimeter"



    '设置字段类型；

    .FieldType(0) = moString

    .FieldType(1) = moDouble

    .FieldType(2) = moDouble



    '设置字段长度；

    .FieldLength(0) = 16

    .FieldPrecision(1) = 15

    .FieldScale(1) = 3

    .FieldPrecision(2) = 15

    .FieldScale(2) = 3

  End With



  Set gds = dc.AddGeoDataset(sName, moPolygon, Desc)

  If gds Is Nothing Then Exit Sub

  

  Set Lyr.GeoDataset = gds

  Map1.Layers.Add Lyr

  Map1.Refresh



  For lPoly = 1 To moPolygons.Count

    With Lyr.Records

      .AddNew

      .Fields("Shape").Value = moPolygons(lPoly)

      .Fields("Name").Value = "Name " & lPoly

      .Fields("Area").Value = moPolygons(lPoly).Area

      .Fields("Perimeter").Value = moPolygons(lPoly).Perimeter

      .Update

    End With

  Next

  Lyr.Records.StopEditing

End Sub



Private Sub Form_Load()

  With moSymbol

    .SymbolType = moFillSymbol

    .Style = moSolidFill

    .Color = moRed

  End With

  Command1.Caption = "保存"

  Me.Caption = "Shape文件生成"

End Sub



Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)

  Dim oPoly As MapObjects2.Polygon

  If moPolygons.Count <> 0 Then

    For Each oPoly In moPolygons

      Map1.DrawShape oPoly, moSymbol

    Next

  End If

End Sub



Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y
As Single)

  Dim oRect As MapObjects2.Rectangle

  Dim oPoly As New MapObjects2.Polygon

    

  Set oPoly = Map1.TrackPolygon

  moPolygons.Add oPoly

  Map1.TrackingLayer.Refresh True

End Sub