阅读:2986回复:9
mo下如何精确画线和多边型??
<P>小弟刚学mo,边看mo帮助,边学,可是E文又很差,所以学的很慢。最近遇到个问题。</P>
<P>我想做一个输入坐标,然后自动生成点,或线,或者生成多边型,就向arcinfo中一样。</P> <P>不知mo能实现吗?请大家帮帮忙!指点一二,谢谢!</P> |
|
1楼#
发布于:2005-03-10 21:02
<P>首先规范数据文件,</P><P>Point.txt文件</P><P>point</P><P>3</P><P>1000,100</P><P>1004,101</P><P>1008,111</P><P>Line.txt文件</P><P>line</P><P>3</P><P>1000,100</P><P>1004,101</P><P>1008,111</P><P>2</P><P>1000,100</P><P>1004,101</P><P>polygon.txt文件</P><P>polygon</P><P>4</P><P>1000,100</P><P>1004,101</P><P>1008,111</P><P>1000,100</P><P>格式确定了,然后再用类似如下代码生成数据</P><P>Dim poly as New MapObjects2.Polygon
Dim pts As New MapObjects2.Points Dim pt As New MapObjects2.Point</P><P>pt.X = 100 pt.Y = 100 pts.Add pt '点的集合</P><P>pt.X = 400 pt.Y = 100 pts.Add pt</P><P>pt.X = 250 pt.Y = 400 pts.Add pt</P><P>pt.X = 100 pt.Y = 100 pts.Add pt</P><P>poly.Parts.Add pts '面的集合</P><P>生成线</P><P>Dim new_line as New MapObjects2.Line Dim pts As New MapObjects2.Points Dim pt As New MapObjects2.Point</P><P>pt.X = 100 pt.Y = 100 pts.Add pt</P><P>pt.X = 200 pt.Y = 200 pts.Add pt</P><P>pt.X = 300 pt.Y = 300 pts.Add pt</P><P>new_line.Parts.Add pts</P> |
|
2楼#
发布于:2005-03-11 13:55
<P>规范数据文件是什么意思 ?那几个文本文件能否说明一下?</P><P>小弟初学,还请不要见笑。</P>
|
|
3楼#
发布于:2005-03-11 21:55
<P>也就是说不需要输入了,直接读取文本文件来自动生成点,或线,或者生成多边型。</P>
|
|
4楼#
发布于:2005-03-14 17:29
<P>我把代码试过了,运行,可是图层上什么也没显示啊?怎么办?</P>
|
|
5楼#
发布于:2005-03-14 22:52
<P>'以下代码为逍遥书生原创,请保留版权信息
Private Sub Form_Load() Dim new_line As New MapObjects2.Line Dim pts As New MapObjects2.Points Dim pt As New MapObjects2.Point '*****添加新的图层***** Dim pSaveConnect As New MapObjects2.DataConnection Dim pSaveShape As New MapObjects2.MapLayer Dim pSaveRecs As New MapObjects2.Recordset '新的实体集 Dim pJsField As Object pSaveConnect.Database = App.Path If Not pSaveConnect.Connect Then Exit Sub '获取数据库结构 Set JsFields = CreateFields pSaveShape.GeoDataset = pSaveConnect.AddGeoDataset("Test", moShapeTypeLine, JsFields) Set pSaveRecs = pSaveShape.Records pSaveRecs.AutoFlush = False</P><P> pSaveRecs.AddNew '做循环,读取数据</P><P> pt.X = 100 pt.Y = 100 pts.Add pt pt.X = 200 pt.Y = 200 pts.Add pt pt.X = 300 pt.Y = 300 pts.Add pt</P><P> new_line.Parts.Add pts</P><P> Set pSaveRecs.Fields("Shape").Value = new_line pSaveRecs.Update Set pFwRecs = Nothing Set pSelectOne = Nothing pSaveRecs.StopEditing Map1.Layers.Add pSaveShape pSaveConnect.Disconnect Map1.Refresh End Sub Function CreateFields() As TableDesc Dim NameCol As New Collection Dim TypeCol As New Collection Dim LengthCol As New Collection Dim ScaleCol As New Collection NameCol.Add "DM" TypeCol.Add moString LengthCol.Add 6 ScaleCol.Add 0 NameCol.Add "X" TypeCol.Add moDouble LengthCol.Add 8 ScaleCol.Add 3 NameCol.Add "Y" TypeCol.Add moDouble LengthCol.Add 4 ScaleCol.Add 1 Set CreateFields = CreateShpFields(NameCol, TypeCol, LengthCol, ScaleCol)</P><P>End Function Function CreateShpFields(inNameCol As Collection, inTypeCol As Collection, inLengthCol As Collection, inScale As Collection) As TableDesc Dim pFields As New TableDesc Dim i As Integer pFields.FieldCount = inNameCol.Count For i = 0 To inNameCol.Count - 1 pFields.FieldName(i) = inNameCol.Item(i + 1) Select Case inTypeCol.Item(i + 1) Case 0 pFields.FieldType(i) = Val(inTypeCol.Item(i + 1)) Case 3 'long pFields.FieldType(i) = Val(inTypeCol.Item(i + 1)) pFields.FieldPrecision(i) = inLengthCol.Item(i + 1) Case 5 'moDouble pFields.FieldType(i) = Val(inTypeCol.Item(i + 1)) pFields.FieldPrecision(i) = inLengthCol.Item(i + 1) pFields.FieldScale(i) = inScale.Item(i + 1) Case 7 'Date pFields.FieldType(i) = Val(inTypeCol.Item(i + 1)) pFields.FieldPrecision(i) = 8 Case 8 'String pFields.FieldType(i) = Val(inTypeCol.Item(i + 1)) pFields.FieldLength(i) = inLengthCol.Item(i + 1) Case 11 'Boolean pFields.FieldType(i) = Val(inTypeCol.Item(i + 1)) End Select Next i Set CreateShpFields = pFields End Function</P> |
|
6楼#
发布于:2005-03-25 19:47
多谢
多谢了!受益非浅 |
|
7楼#
发布于:2005-05-06 06:17
好同志啊
|
|
|
8楼#
发布于:2005-05-06 09:23
<P>顶一个</P>
|
|
|
9楼#
发布于:2005-06-21 00:35
收藏了当然要顶了!
|
|