一段代码，可以把POLYGON类型加入一个图层，但是换别的图形就不行呢

<P>Dim mosymbol As New MapObjects2.Symbol
Dim mopolygons As New Collection
Dim extrect As MapObjects2.Ellipse
Dim ptt As Integer</P>
<P>Private Sub Command1_Click()
    Dim gds As MapObjects2.GeoDataset
    Dim sname As String
    Dim desc As New MapObjects2.TableDesc
    Dim dc As New MapObjects2.DataConnection
    Dim lyr As New MapObjects2.MapLayer
    Dim lpoly As Long
    
    CommonDialog1.Filter = "SHAPE FILES(*.shp)|*.shp"
    CommonDialog1.DefaultExt = ".shp"
    CommonDialog1.ShowSave
    
    If Len(CommonDialog1.FileName) = 0 Then Exit Sub
    dc.Database = CurDir
    
    If Not dc.Connect Then Exit Sub
    
    sname = Left(CommonDialog1.FileTitle, Len(CommonDialog1.FileTitle) - 4)
    
    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
        .FieldPrecision(2) = 15
        
        .FieldScale(1) = 3
        .FieldScale(2) = 3
    End With
    
        Set gds = dc.AddGeoDataset(sname, moShapeTypeEllipse, desc)
    </P>
<P>    ‘问题总是出在这里，不知道为什么
    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
End Sub</P>
<P>Private Sub Form_Load()
    With mosymbol
        .SymbolType = moFillSymbol
        .Style = moSolidFill
        .Color = moPaleYellow
    End With
End Sub</P>
<P>Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
    Dim opoly As MapObjects2.Ellipse</P>
<P>        If mopolygons.Count <> 0 Then
            For Each opoly In mopolygons
                Map1.DrawShape opoly, mosymbol
            Next
        End If
End Sub</P>
<P>Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then Exit Sub
    
    Dim opoly As New MapObjects2.Ellipse
    
    If ptt = 2 Then
        Dim r As MapObjects2.Rectangle
        Set r = Map1.TrackRectangle
        Map1.Extent = r
    ElseIf ptt = 1 Then
        Set extrect = Map1.Extent
        extrect.ScaleRectangle 1.5
        Map1.Extent = extrect
    ElseIf ptt = 3 Then
        Map1.Pan
    ElseIf ptt = 4 Then
        Set opoly = Map1.TrackCircle
        mopolygons.Add opoly
        Map1.TrackingLayer.Refresh True
    ElseIf ptt = 5 Then
        
    End If
End Sub</P>
<P>Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
    Case "zoomout"
        ptt = 1
    Case "zoomin"
        ptt = 2
    Case "pan"
        ptt = 3
    Case "polygon"
        ptt = 4
    Case "rec"
        ptt = 5
    End Select
End Sub
</P>

<P>Set gds = dc.AddGeoDataset(sname, moShapeTypeEllipse, desc)</P><P>moShapeTypeEllipse
点，线，面是不同类型~shapetype也不一样~应该区分</P>

<img src="images/post/smile/dvbbs/em06.gif" />