阅读:1569回复:5
[在线等]求助:vb+mo, map里画点
<P>比如在MAP里加载了北京地图,Shape格式的,我现在要在地图上画一经纬度坐标点,(116.367560625909 49.1173667907715 ),怎么画出来,怎么保存为SHP的图层?谢谢了.
</P><img src="images/post/smile/dvbbs/em02.gif" /> [此贴子已经被作者于2005-5-10 9:45:36编辑过]
|
|
|
1楼#
发布于:2005-05-10 10:04
<P>谁能告诉我啊</P><img src="images/post/smile/dvbbs/em02.gif" />
|
|
|
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" />
|
|
|
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> |
|
|
4楼#
发布于:2005-05-11 11:26
<img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" />
|
|
|
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> |
|
|