MO空间分析的实现[讨论]

程序实现合并线对象的操作，请大家在后面跟上自己的作品和感想，让大家一起来完成各种功能，也可以提出空间分析包括哪些功能，让大家完成，多谢支持！
程序数据
<a href="attachment/20039271537711227.rar">20039271537711227.rar</a>
程序界面


Option Explicit
Private recsFirstToJoin As MapObjects2.Recordset
Private recsSecondToJoin As MapObjects2.Recordset
Private recsSelected As MapObjects2.Recordset
Private symToJoin As MapObjects2.Symbol
Private symSelected As MapObjects2.Symbol

Private Sub Command1_Click()

Dim recsLayer As MapObjects2.Recordset
Dim lnNew As MapObjects2.Line
Dim lnFirst As MapObjects2.Line
Dim lFeatureID1 As Long
Dim lFeatureID2 As Long
Dim lnSecond As MapObjects2.Line
Dim i As Long

'必须有两根line.
If recsFirstToJoin Is Nothing Then Exit Sub
If recsSecondToJoin Is Nothing Then Exit Sub

'取得第一个记录
Set lnNew = New MapObjects2.Line
Set lnFirst = recsFirstToJoin.Fields("Shape").Value
lFeatureID1 = recsFirstToJoin.Fields("FeatureID").Value
For i = 0 To lnFirst.Parts.Count - 1
  lnNew.Parts.Add lnFirst.Parts(i)
Next i
Set lnSecond = recsSecondToJoin.Fields("Shape").Value
lFeatureID2 = recsSecondToJoin.Fields("FeatureID").Value
For i = 0 To lnSecond.Parts.Count - 1
  lnNew.Parts.Add lnSecond.Parts(i)
Next i

'Ensure lFeatureID1 is the larger number
If lFeatureID2 > lFeatureID1 Then
  i = lFeatureID2
  lFeatureID2 = lFeatureID1
  lFeatureID1 = i
End If

'取得层的记录编辑
Set recsLayer = Map1.Layers(0).Records

'添家一个新的记录到连接的对象
If recsLayer.Updatable Then
  'Set lnNew = New MapObjects2.Line
  recsLayer.AddNew
  Set recsLayer.Fields("Shape").Value = lnNew
  'EDIT ALL OTHER FIELDS HERE - UP TO YOU HOW YOU DO IT
  'DO YOU WANT TO ADD NUMERIC FIELDS, OR AVERAGE THEM?
  'DO YOU WANT TO COPY THE FIRST RECORD'S STRING VALUE OR THE SECOND?
  recsLayer.Update
End If
recsLayer.StopEditing

'删除输入的记录
recsLayer.MoveFirst
For i = 2 To lFeatureID1
  recsLayer.MoveNext
Next i
recsLayer.Delete
recsLayer.StopEditing

'删除第二个输入记录
recsLayer.MoveFirst
For i = 2 To lFeatureID2
  recsLayer.MoveNext
Next i
recsLayer.Delete
recsLayer.StopEditing

'清除选择的line
Set recsFirstToJoin = Nothing
Set recsSecondToJoin = Nothing
Set recsSelected = Nothing
Map1.Refresh

End Sub

Private Sub Form_Load()

'加载数据
Dim dc As New MapObjects2.DataConnection
Dim mlyr As New MapObjects2.MapLayer
dc.Database = App.Path
dc.Connect
Set mlyr.GeoDataset = dc.FindGeoDataset("lines")
mlyr.Symbol.Color = moBlue
Map1.Layers.Add mlyr

'放大
Dim rect As MapObjects2.Rectangle
Set rect = Map1.FullExtent
rect.ScaleRectangle 1.1
Set Map1.FullExtent = rect
Set Map1.Extent = rect

'符号
Set symToJoin = New MapObjects2.Symbol
With symToJoin
  .SymbolType = moLineSymbol
  .Style = moSolidLine
  .Color = moGreen
  .Size = 2
End With
Set symSelected = New MapObjects2.Symbol
With symSelected
  .SymbolType = moLineSymbol
  .Style = moSolidLine
  .Color = moYellow
  .Size = 3
End With

End Sub

Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)

Dim lnFirst As MapObjects2.Line
Dim lnSecond As MapObjects2.Line

'显示选择连接的线
If Not recsFirstToJoin Is Nothing Then
  If Not recsFirstToJoin.EOF Then
    Set lnFirst = recsFirstToJoin.Fields("Shape").Value
    Map1.DrawShape lnFirst, symToJoin
  End If
End If
If Not recsSecondToJoin Is Nothing Then
  If Not recsSecondToJoin.EOF Then
    Set lnSecond = recsSecondToJoin.Fields("Shape").Value
    Map1.DrawShape lnSecond, symToJoin
  End If
End If

End Sub

Private Sub Map1_BeforeLayerDraw(ByVal index As Integer, ByVal hDC As stdole.OLE_HANDLE)

Dim lnSimple As MapObjects2.Line

'显示选择对象
If index = 0 Then
  If Not recsSelected Is Nothing Then
    If Not recsSelected.EOF Then
      Set lnSimple = recsSelected.Fields("Shape").Value
      Map1.DrawShape lnSimple, symSelected
    End If
  End If
End If

End Sub

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim recsDestination As MapObjects2.Recordset
Dim pt As MapObjects2.Point
Dim tol As Double
Dim i As Long, j As Long

Set pt = Map1.ToMapPoint(X, Y)
tol = Map1.ToMapDistance(3 * Screen.TwipsPerPixelX)

Select Case True
  Case Option1  'SELECT A FIRST LINE TO JOIN
    Set recsFirstToJoin = Map1.Layers(0).SearchByDistance(pt, tol, "")
    Set recsSelected = Nothing
  Case Option2  'SELECT A SECOND LINE TO JOIN
    Set recsSecondToJoin = Map1.Layers(0).SearchByDistance(pt, tol, "")
    Set recsSelected = Nothing
  Case Option3  'SIMPLE SELECT A LINE IN THE LAYER
    Set recsFirstToJoin = Nothing
    Set recsSecondToJoin = Nothing
    Set recsSelected = Map1.Layers(0).SearchByDistance(pt, tol, "")
End Select

Map1.Refresh
    
End Sub

以下是引用kerry在2003-9-28 12:06:27的发言：
谢谢了。我赶快把她下下来。。

记得发表点想法，大家别都看了以后就没了啊！<img src="images/post/smile/dvbbs/em18.gif" />

谢谢了 very urgent!!!!!!!!!!

好东东

这个好像以前见过？

好

thank you !

thx

谢谢

辛苦啊