[求助]如何在MO+VB实现绘制矩形和椭圆并保存。

前段时间我在MO+VB中实现了绘制点、线、多边形并保存。但没有实现绘制矩形和椭圆并保存，我觉得前三者的实现是完全一样，通过在map控件中定点然后保存点的记录就可以实现。但在实现了绘制矩形和椭圆后怎样保存已绘制的对象我觉得按照实现点、线、多边形的思路是无法实现的。请斑竹和大虾指点迷津。谢谢了
     学习MO贵在交流，现在我真的深有感触，在这里学到了不少东西！！，希望能有更大的收获！！

这个问题以前也讨论过，只是一直也没好的解决方法。我找了个把trakinglayer对象保存到shp中的例子，不过他里面实现的是多边形，你可以换成椭圆和其他看看。

Option Explicit

Dim tl As MapObjects2.TrackingLayer
Dim dc As New MapObjects2.DataConnection
Dim mlyr As New MapObjects2.MapLayer
Dim recs As MapObjects2.Recordset

Private Sub Command1_Click()

'Move TrackingLayer polygons into the shapefile
Dim i As Integer
For i = 0 To tl.EventCount - 1
  recs.AddNew
  Set recs.Fields("Shape").Value = tl.Event(i).Shape
  recs.Update
Next
recs.StopEditing

'Clear the tracking layer and redraw
tl.ClearEvents
Map1.Refresh


End Sub

Private Sub Form_Load()

dc.Database = App.Path
dc.Connect
Set mlyr.GeoDataset = dc.FindGeoDataset("polys")
Set recs = mlyr.Records
mlyr.Symbol.Color = moLightGray
Map1.Layers.Add mlyr

'Configure TrackingLayer and symbols
Set tl = Map1.TrackingLayer
tl.SymbolCount = 2
With tl.Symbol(0)
  .SymbolType = moFillSymbol
  .Style = moSolidFill
  .Color = moRed
End With
With tl.Symbol(1)
  .SymbolType = moLineSymbol
  .Style = moSolidLine
  .Color = moRed
End With


End Sub

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

Dim poly As MapObjects2.Polygon

Set poly = Map1.TrackPolygon
tl.AddEvent poly, 0

End Sub

3楼的方法很好，帮我解决了问题。3Q

但是矩形和圆都要画两次才能画上。为什么？

画圆形时，第一次点的是圆心，然后拖运得到半径；
画矩形时，第一次点的是起点，然后拖运得到大小。

终于实现了。谢谢ly_sunny和斑竹，谢谢大虾。我把代码整理一下再发到帖子上让有这方面问题的同道们功享！！

期待！

以下是绘制矩形并保存的代码，希望对大家有帮助。绘制椭圆保存的代码基本相同。
Option Explicit
Dim rect As MapObjects2.Rectangle
Dim moSymbol As New MapObjects2.Symbol
Dim moRectangles 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 lrect As Long

  With CommonDialog1
    .Filter = "ESRI Shapefiles (*.shp)|*.shp"
    .DefaultExt = ".shp"
    .ShowSave
    
    If Len(.FileName) = 0 Then Exit Sub  ' cancel
    dc.Database = CurDir
    If Not dc.Connect Then Exit Sub   ' bad dataConnection
    ' È¥³ýÀ©Õ¹Ãû¡££¨remove the extension£©
    sName = Left(.FileTitle, Len(.FileTitle) - 4)
  End With

  With desc
    ' ¶¨Òå¼Ç¼Êý¡££¨define three additional fields£©
    .FieldCount = 3

    'set the field names
    .FieldName(0) = "Name"
    .FieldName(1) = "Area"
    .FieldName(2) = "Perimeter"

    ' set the type of field
    .FieldType(0) = moString
    .FieldType(1) = moDouble
    .FieldType(2) = moDouble

    ' set the length of a character field

    .FieldLength(0) = 16

    ' set the number of digits used in the field
    .FieldPrecision(1) = 15
    .FieldPrecision(2) = 15

    ' set the number of digits to the right of the decimal point
    .FieldScale(1) = 3
    .FieldScale(2) = 3
  End With

  Set gds = dc.AddGeoDataset(sName, moShapeTypePolygon, desc)
  If gds Is Nothing Then Exit Sub   ' invalid file

  Set lyr.GeoDataset = gds
  For lrect = 1 To moRectangles.Count
    With lyr.Records
      .AddNew
      .Fields("Shape").Value = moRectangles(lrect)
      .Fields("Name").Value = "Name " & lrect
      .Fields("Area").Value = moRectangles(lrect).Area
      .Fields("Perimeter").Value = moRectangles(lrect).Perimeter
      .Update
    End With
  Next
  lyr.Records.StopEditing
End Sub


Private Sub Form_Load()
  With moSymbol
    .SymbolType = moFillSymbol
    .Style = moSolidFill
    .Color = moPaleYellow
  End With
  Command1.Caption = "±£´æͼ²ã(*.shp)"
End Sub


Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As Stdole.OLE_HANDLE)
   Dim Plog As New MapObjects2.Polygon
  If moRectangles.Count <> 0 Then
    For Each Plog In moRectangles
      Map1.DrawShape Plog, moSymbol
    Next
  End If
End Sub


Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
   Dim rect As MapObjects2.Rectangle
   Dim Plog As MapObjects2.Polygon
   Set rect = Map1.TrackRectangle
   Map1.TrackingLayer.AddEvent rect, 0
   Set Plog = rect.Buffer(0)
   moRectangles.Add Plog
   Map1.TrackingLayer.Refresh True
End Sub

不知为什么，我的中文标注一拷进去就变成了乱码。不过我想不会影响大家看代码的。有问题就跟我联系！！

好，支持，期待更多兄弟来交流！