yyw215
路人甲
路人甲
  • 注册日期2004-12-17
  • 发帖数17
  • QQ
  • 铜币205枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:1371回复:5

[在线等]求助:vb+mo, map里画点

楼主#
更多 发布于:2005-05-10 09:42
<P>比如在MAP里加载了北京地图,Shape格式的,我现在要在地图上画一经纬度坐标点,(116.367560625909    49.1173667907715 ),怎么画出来,怎么保存为SHP的图层?谢谢了.
  </P><img src="images/post/smile/dvbbs/em02.gif" />
[此贴子已经被作者于2005-5-10 9:45:36编辑过]
喜欢0 评分0
yyw215@163.com QQ:79922749
yyw215
路人甲
路人甲
  • 注册日期2004-12-17
  • 发帖数17
  • QQ
  • 铜币205枚
  • 威望0点
  • 贡献值0点
  • 银元0个
1楼#
发布于:2005-05-10 10:04
<P>谁能告诉我啊</P><img src="images/post/smile/dvbbs/em02.gif" />
yyw215@163.com QQ:79922749
举报 回复(0) 喜欢(0)     评分
yyw215
路人甲
路人甲
  • 注册日期2004-12-17
  • 发帖数17
  • QQ
  • 铜币205枚
  • 威望0点
  • 贡献值0点
  • 银元0个
2楼#
发布于:2005-05-11 10:05
<P>就这一个小问题啊,大虾们,帮帮我</P><img src="images/post/smile/dvbbs/em12.gif" /><img src="images/post/smile/dvbbs/em12.gif" /><img src="images/post/smile/dvbbs/em12.gif" /><img src="images/post/smile/dvbbs/em24.gif" /><img src="images/post/smile/dvbbs/em30.gif" />
yyw215@163.com QQ:79922749
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15947
  • QQ554730525
  • 铜币25339枚
  • 威望15364点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
3楼#
发布于:2005-05-11 10:56
<P>下面这个函数,可以建立三种类型的图层,并添加要素,你可以看看参数的设置</P><P>Private Function MakeShape(ByVal yCol As Long, _
                           ByVal xRow As Long, _
                           ByVal iShapeType As Integer) _
                           As Object
                          
Dim pt As MapObjects2.Point
Dim pts As New MapObjects2.Points
Dim shp As Object</P><P>Select Case iShapeType
  Case moShapeTypePoint
    Set shp = New MapObjects2.Point
'    shp.Set xRow, yCol
    shp.X = xRow
    shp.Y = yCol
    
  Case moShapeTypeLine
    Set shp = New MapObjects2.Line
    Set pt = New MapObjects2.Point
    pt.X = xRow
    pt.Y = yCol
    pts.Add pt
    Set pt = New MapObjects2.Point
    pt.X = xRow + 0.75
    pt.Y = yCol + 0.75
    pts.Add pt
    shp.Parts.Add pts
    
  Case moShapeTypePolygon
    Set shp = New MapObjects2.Polygon
    Set pt = New MapObjects2.Point
    pt.X = xRow
    pt.Y = yCol
    pts.Add pt
    Set pt = New MapObjects2.Point
    pt.X = xRow
    pt.Y = yCol + 0.75
    pts.Add pt
    Set pt = New MapObjects2.Point
    pt.X = xRow + 0.75
    pt.Y = yCol + 0.75
    pts.Add pt
    Set pt = New MapObjects2.Point
    pt.X = xRow + 0.75
    pt.Y = yCol
    pts.Add pt
    shp.Parts.Add pts
End Select</P><P>Set MakeShape = shp</P><P>End Function
</P>
举报 回复(0) 喜欢(0)     评分
yyw215
路人甲
路人甲
  • 注册日期2004-12-17
  • 发帖数17
  • QQ
  • 铜币205枚
  • 威望0点
  • 贡献值0点
  • 银元0个
4楼#
发布于:2005-05-11 11:26
<img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" />
yyw215@163.com QQ:79922749
举报 回复(0) 喜欢(0)     评分
olympic0408
路人甲
路人甲
  • 注册日期2005-02-18
  • 发帖数82
  • QQ
  • 铜币378枚
  • 威望0点
  • 贡献值0点
  • 银元0个
5楼#
发布于:2005-05-16 17:25
<P>Dim p_dc As MapObjects2.DataConnection
Dim rect As MapObjects2.Rectangle
Dim Loc As New MapObjects2.Point
Dim pts As MapObjects2.Points
Dim poi As Point
Dim sym As Symbol</P><P>Dim layer As MapLayer</P><P>
Private Sub Command1_Click()
        
        
        Dim jx1 As Integer, jx2 As Integer, jx3 As Integer
        Dim wy1 As Integer, wy2 As Integer, wy3 As Integer
        Dim x1 As Single, y1 As Single
        Dim str3 As String, str4 As String
        Dim pRec As New MapObjects2.Recordset
        Dim a As Single, b As Single
        Dim X As Single, Y As Single
        Dim newx As Single, newy As Single
        Dim fx As Single, fy As Single
        Dim pLayer As New MapObjects2.MapLayer
        Dim pReset As MapObjects2.Recordset
        
       If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Or Text4.Text = "" Or Text4.Text = "" Or Text5.Text = "" Or Text6.Text = "" Then
       MsgBox ("坐标不能为空")
       Exit Sub
       End If
       If MsgBox("确保你输入的坐标正确!", vbYesNo) = vbYes Then
      
      
        
        
        jx1 = Val(Text1.Text)
        jx2 = Val(Text2.Text)
        jx3 = Val(Text3.Text)
        wy1 = Val(Text4.Text)
        wy2 = Val(Text5.Text)
        wy3 = Val(Text6.Text)
        a = Format((jx3 / 60 + jx2) / 60, "0.000")
        b = Format((wy3 / 60 + wy2) / 60, "0.000")
        
      
        x1 = jx1 + a
        y1 = wy1 + b</P><P>        Set poi = New MapObjects2.Point</P><P>
        
        poi.X = x1
        poi.Y = y1</P><P>        Map1.TrackingLayer.AddEvent poi, 0
        Map1.TrackingLayer.Refresh True
        
        MsgBox ("点已经成功添加")</P><P>        Else
        Exit Sub
        End If
        </P><P>End Sub</P><P>Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
Dim sym As New Symbol
 sym.Color = moRed</P><P>
sym.SymbolType = moPointSymbol
sym.Size = 5</P><P>If Not pts Is Nothing Then
Map1.DrawShape poi, sym
End If</P><P>End Sub</P><P>
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
If Toolbar1.Buttons(1).Value = tbrPressed Then
Dim dc As New DataConnection</P><P>CommonDialog1.Filter = "ESRI Shapefiles (*.shp)|*.shp"
  CommonDialog1.ShowOpen
  If Len(CommonDialog1.FileName) = 0 Then Exit Sub
  dc.Database = CurDir
  If Not dc.Connect Then Exit Sub</P><P>  Dim name As String
  name = Left(CommonDialog1.FileTitle, Len(CommonDialog1.FileTitle) - 4)
  Dim gtemp As GeoDataset
  Set gtemp = dc.FindGeoDataset(name)
  If gtemp Is Nothing Then Exit Sub
  
  Set temp_layer = New MapLayer
  Set temp_layer.GeoDataset = gtemp
  
  Map1.Layers.Clear
  Map1.Layers.Add temp_layer
  Map1.Extent = Map1.FullExtent
  Map1.Refresh
ElseIf Toolbar1.Buttons(2).Value = tbrPressed Then
  
 '保存所有的点
      
   Dim p_dc As New MapObjects2.DataConnection
   Dim pGDS As MapObjects2.GeoDataset
   Dim pDesc As New TableDesc
   Dim i As Integer
   Dim pLayer As MapObjects2.MapLayer
   Dim pRecSet As MapObjects2.Recordset
   Dim sname As String
   Dim str As String
  
   Set dc = New MapObjects2.DataConnection
   Set pLayer = New MapObjects2.MapLayer
  
  
   With CommonDialog2
    .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 pDesc
   .FieldCount = 2
   '添加字段名</P><P>   .FieldName(0) = "Latitude"
   .FieldName(1) = "Longitude"
   '字段类型
   </P><P>   .FieldType(0) = moDouble
   .FieldType(1) = moDouble
   '字段长度</P><P>
'
   .FieldLength(0) = 19
   .FieldPrecision(0) = 18
   .FieldScale(0) = 11
    .FieldLength(1) = 19
    .FieldPrecision(1) = 18
    .FieldScale(1) = 11
    End With
    
    
    Set pGDS = dc.AddGeoDataset(sname, moShapeTypePoint, pDesc)
    If pGDS Is Nothing Then Exit Sub
    Set pLayer.GeoDataset = pGDS
    
   For i = 0 To Map1.TrackingLayer.EventCount - 1
    
    
    
    With pLayer.Records
    .AddNew
   .Fields("Shape").Value = Map1.TrackingLayer.Event(i).Shape
   .Fields("Latitude").Value = Map1.TrackingLayer.Event(i).X
  
        
   .Fields("Longitude").Value = Map1.TrackingLayer.Event(i).Y
    
    .Update
      
    End With
  
    Next
    pLayer.Records.StopEditing
    
  </P><P>ElseIf Toolbar1.Buttons(3).Value = tbrPressed Then
 
 End
 End If
 
  
End Sub</P>
=================== QQ:77837769 email:olympic0408@163.com =============
举报 回复(0) 喜欢(0)     评分
游客

返回顶部