shbq13952053115
路人甲
路人甲
  • 注册日期2005-05-24
  • 发帖数21
  • QQ
  • 铜币150枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:1711回复:2

看看这程序

楼主#
更多 发布于:2005-07-04 15:01
<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>
喜欢0 评分0
shbq13952053115
路人甲
路人甲
  • 注册日期2005-05-24
  • 发帖数21
  • QQ
  • 铜币150枚
  • 威望0点
  • 贡献值0点
  • 银元0个
1楼#
发布于:2005-07-04 16:31
<P>感谢总统  向你学习啊</P><img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em02.gif" />
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15951
  • QQ
  • 铜币25345枚
  • 威望15368点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
2楼#
发布于: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>
GIS麦田守望者,期待与您交流。
举报 回复(0) 喜欢(0)     评分
游客

返回顶部