wangjunjolly
路人甲
路人甲
  • 注册日期2003-09-11
  • 发帖数356
  • QQ
  • 铜币1040枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:2307回复:4

请教:MO+VB实现绘制并保存点和线的问题。

楼主#
更多 发布于:2003-09-19 14:00
我刚学习MO,想利用MO+VB实现绘制并保存点和线。不知如何进行。请帮忙指点。
谢谢!!
喜欢0 评分0
wangjunjolly
路人甲
路人甲
  • 注册日期2003-09-11
  • 发帖数356
  • QQ
  • 铜币1040枚
  • 威望0点
  • 贡献值0点
  • 银元0个
1楼#
发布于:2003-09-19 14:26
谢谢大家。此问题我已经解决了。
举报 回复(0) 喜欢(0)     评分
wangjunjolly
路人甲
路人甲
  • 注册日期2003-09-11
  • 发帖数356
  • QQ
  • 铜币1040枚
  • 威望0点
  • 贡献值0点
  • 银元0个
2楼#
发布于:2003-09-26 21:04
我会将代码放上来的。因为我这几天太忙,稍过两天好好整理后再放上来。请谅解!!
举报 回复(0) 喜欢(0)     评分
wangjunjolly
路人甲
路人甲
  • 注册日期2003-09-11
  • 发帖数356
  • QQ
  • 铜币1040枚
  • 威望0点
  • 贡献值0点
  • 银元0个
3楼#
发布于:2003-09-26 21:17
这是我从MO的帮助中摘录的绘制多边形并保存的说明及源代码。按照说明就可以实现绘制并保存多边形。绘制点、线并保存的原理和这完全一样。我想这对大家应该有直接的帮助。有问题再联系。    
This example uses the AddGeoDataset method and the TableDesc properties to create a new shapefile that represents a GeoDataset with polygon features in a DataConnection. In addition, the code associates the GeoDataset with a MapLayer, adding it to the Map. The TableDesc properties define three additional fields in the Recordset. For each feature added, the code invokes the AddNew and Update methods to populate the fields of the Recordset. To try this example, paste the code into the Declarations section of a form containing a CommonDialog control named CommonDialog1, a CommandButton named Command1 and Map named Map1 that contains a MapLayer or an ImageLayer. This layer will serve as a background layer, providing the coordinates and map units of the new MapLayer. Click F5, and track polygons by clicking on the map, a double-click signals the end of a polygon. When you've added the polygons you want, click the Save button to specify the name of the shapefile.

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

  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, moPolygon, desc)
  If gds Is Nothing Then Exit Sub   ' invalid file

  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 = moPaleYellow
  End With
  Command1.Caption = "Save"

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
  
  If Button = 1 Then
    Set oPoly = Map1.TrackPolygon

    moPolygons.Add oPoly
    Map1.TrackingLayer.Refresh True
  Else
    Set oRect = Map1.Extent
    oRect.ScaleRectangle 0.5
    Map1.Extent = oRect
  End If
  
End Sub
举报 回复(0) 喜欢(0)     评分
wangjunjolly
路人甲
路人甲
  • 注册日期2003-09-11
  • 发帖数356
  • QQ
  • 铜币1040枚
  • 威望0点
  • 贡献值0点
  • 银元0个
4楼#
发布于:2003-09-26 21:19
我也在论坛中回答了一位兄弟的问题。他是绘制点并保存,我希望他能从这里找到灵感!!
      我是初学者,说的不对请包涵!!希望斑竹和大虾多多帮助多多指导!!!
举报 回复(0) 喜欢(0)     评分
游客

返回顶部