阅读:1710回复:2
看看这程序
<P>下面是一段画点并保存的程序,保存后发现没有图形,但是DBF文件是对的 </P>
<P>不知道错在哪里 请高手指点12</P> <P>Option Explicit</P> <P><BR>Dim moSymbol As New MapObjects2.Symbol<BR>Dim moPolygons As New MapObjects2.Points<BR>Private Sub Command1_Click()<BR> Dim gds As MapObjects2.GeoDataset<BR> Dim sName As String<BR> Dim Desc As New TableDesc<BR> Dim dc As New DataConnection<BR> Dim Lyr As New MapObjects2.MapLayer<BR> Dim lPoly As Long<BR> <BR> If moPolygons.Count < 1 Then<BR> MsgBox "先在地图上画点"<BR> Exit Sub<BR> End If<BR> <BR> With CommonDialog1<BR> .Filter = "ESRI Shapefiles (*.shp)|*.shp"<BR> .DefaultExt = ".shp"<BR> .ShowSave<BR> If Len(.FileName) = 0 Then Exit Sub<BR> dc.Database = CurDir<BR> If Not dc.Connect Then Exit Sub<BR> <BR> <BR> sName = Left(.FileTitle, Len(.FileTitle) - 4)<BR> End With<BR> MsgBox sName<BR> With Desc<BR> .FieldCount = 3<BR> <BR> .FieldName(0) = "Name"<BR> .FieldName(1) = "Area"<BR> .FieldName(2) = "Perimeter"</P> <P> .FieldType(0) = moString<BR> .FieldType(1) = moDouble<BR> .FieldType(2) = moDouble</P> <P> .FieldLength(0) = 16<BR> .FieldPrecision(1) = 15<BR> .FieldScale(1) = 3<BR> .FieldPrecision(2) = 15<BR> .FieldScale(2) = 3<BR> End With<BR> Set gds = dc.AddGeoDataset(sName, moPoint, Desc)<BR> If gds Is Nothing Then Exit Sub<BR> <BR> Set Lyr.GeoDataset = gds<BR> Map1.Layers.Add Lyr<BR> Map1.Refresh<BR> For lPoly = 1 To moPolygons.Count<BR> With Lyr.Records<BR> .AddNew<BR> <BR> .Fields("Name").Value = "Name " ; lPoly<BR> <BR> <BR> .Update<BR> End With<BR> Next<BR> Lyr.Records.StopEditing<BR>End Sub<BR>Private Sub Form_Load()<BR> With moSymbol<BR> .SymbolType = moFillSymbol<BR> .Style = moSolidFill<BR> .Color = moRed<BR> End With<BR> Command1.Caption = "保存"<BR> Me.Caption = "Shape文件生成"<BR>End Sub<BR>Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)<BR> Dim oPoly As MapObjects2.Point<BR> If moPolygons.Count <> 0 Then<BR> For Each oPoly In moPolygons<BR> Map1.DrawShape oPoly, moSymbol<BR> Next<BR> End If<BR>End Sub<BR>Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)<BR> Dim oRect As MapObjects2.Rectangle<BR> Dim oPoly As New MapObjects2.Point<BR> <BR> Set oPoly = Map1.ToMapPoint(X, Y)<BR> moPolygons.Add oPoly<BR> Map1.TrackingLayer.Refresh True<BR>End Sub</P> |
|
1楼#
发布于:2005-07-04 15:55
<P><STRONG>如何把mo中的trackinglayer保存到shp图层</STRONG><BR></P>
<P><a href="http://gisempire.com/bbs/dispbbs.asp?BoardID=39;ID=348;replyID=;skin=1" target="_blank" >http://gisempire.com/bbs/dispbbs.asp?BoardID=39;ID=348;replyID=;skin=1</A></P> |
|
|
2楼#
发布于:2005-07-04 16:31
<P>感谢总统 向你学习啊</P><img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em02.gif" />
|
|