VB实现几何对象的空间分析操作（交、并、差、异或）

Dim shape1 As Boolean '判断是否已经获得一个几何形状
　　Dim shp As Object '第一个输入的形状
　　Dim shp2 As Object '第二个输入的形状
　　Private Sub Form_Load()
　　Option3.Caption = "差运算"
　　Option4.Caption = "交运算"
　　Option5.Caption = "并运算"
　　Option6.Caption = "异或运算"
　　Option7.Caption = "线"
　　Option8.Caption = "多边形"
　　shape1 = True
　　Dim dc As New MapObjects2.DataConnection
　　dc.Database = "D:Program FilesESRIMapObjects2SamplesDataUSA"
　　If Not dc.Connect Then
　　MsgBox "连接错误", vbCritical, "连接错误"
　　End
　　End If
　　Dim layer As New MapObjects2.MapLayer
　　Set layer.GeoDataset = dc.FindGeoDataset("States")
　　If layer Is Nothing Then
　　MsgBox "找不到需要的图层"
　　End
　　Else
　　layer.Symbol.Color = moPaleYellow
　　Map1.BackColor = moNavy
　　Map1.Layers.Add layer
　　Dim r As New MapObjects2.Rectangle
　　Set r = Map1.FullExtent
　　Map1.Extent = r
　　Map1.ScrollBars = False
　　End If
　　'创建Trackinglayer的符号属性
　　Map1.TrackingLayer.SymbolCount = 6
　　With Map1.TrackingLayer.Symbol(0)
　　.SymbolType = moPointSymbol
　　.Style = moTriangleMarker
　　.Color = moRed
　　.Size = 5
　　End With
　　With Map1.TrackingLayer.Symbol(1)
　　.SymbolType = moLineSymbol
　　.Color = moRed
　　.Size = 3
　　End With
　　With Map1.TrackingLayer.Symbol(2)
　　.SymbolType = moFillSymbol
　　.Style = moGrayFill
　　.Color = moRed
　　.OutlineColor = moRed
　　End With
　　With Map1.TrackingLayer.Symbol(3)
　　.SymbolType = moFillSymbol
　　.Style = moGrayFill
　　.Color = moGreen
　　.OutlineColor = moGreen
　　End With
　　With Map1.TrackingLayer.Symbol(4)
　　.SymbolType = moLineSymbol
　　.Style = moDotLine
　　.Color = moGreen
　　.Size = 3
　　End With
　　With Map1.TrackingLayer.Symbol(5)
　　.SymbolType = moPointSymbol
　　.Style = moTriangleMarker
　　.Color = moGreen
　　.Size = 5
　　End With
　　End Sub
　　Private Sub Command1_Click()
　　Map1.TrackingLayer.ClearEvents
　　Set shp = Nothing
　　Set shp2 = Nothing
　　shape1 = True
　　Label1.Caption = "更新Tracking Layer...无已获得的图形"
　　End Sub
　　Private Function trackShape() As Object '根据用户的选择在trackinglayer上创建图形
　　If Option7.Value Then
　　Dim line As New MapObjects2.line
　　Set line = Map1.TrackLine
　　Set trackShape = line
　　Dim evline As New MapObjects2.GeoEvent
　　Set evline = Map1.TrackingLayer.AddEvent(line, 1)
　　ElseIf Option8.Value Then
　　Dim poly As New MapObjects2.Polygon
　　Set poly = Map1.TrackPolygon
　　Set trackShape = poly
　　Dim evpoly As New MapObjects2.GeoEvent
　　Set evpoly = Map1.TrackingLayer.AddEvent(poly, 2)
　　End If
　　End Function
　　Private Sub drawRes(shape As Object) '在Trackinglayer上通过添加Geoevent的方法绘制shape
　　Dim res As New MapObjects2.GeoEvent
　　If shape.shapeType = moLine Then
　　Set res = Map1.TrackingLayer.AddEvent(shape, 4)
　　ElseIf shape.shapeType = moShapeTypePolygon Or shape.shapeType = moShapeTypeRectangle Then
　　Set res = Map1.TrackingLayer.AddEvent(shape, 3)
　　ElseIf shape.shapeType = moShapeTypePoint Or shape.shapeType = moShapeTypeMultipoint Then
　　Set res = Map1.TrackingLayer.AddEvent(shape, 5)
　　End If
　　End Sub　Private Sub Difference(firstShape As Object, secondShape As Object) '两个图形加入收藏 差运算
　　Dim diffResult As Object
　　Set diffResult = firstShape.Difference(secondShape)
　　If Not diffResult Is Nothing Then
　　Call drawRes(diffResult)
　　Else
　　Label1.Caption = "差运算无返回结果..."
　　End If
　　End Sub
　　Private Sub Intersect(firstShape As Object, secondShape As Object) '两个图形交运算
　　Dim interResult As Object
　　Set interResult = firstShape.Intersect(secondShape)
　　If Not interResult Is Nothing Then
　　Call drawRes(interResult)
　　Else
　　Label1.Caption = "交运算无返回结果..."
　　End If
　　End Sub
　　Private Sub Union(firstShape As Object, secondShape As Object) '两个图形并运算
　　Dim unionResult As Object
　　Set unionResult = firstShape.Union(secondShape)
　　If Not unionResult Is Nothing Then
　　Call drawRes(unionResult)
　　Else
　　Label1.Caption = "差运算无返回结果..."
　　End If
　　End Sub
　　Private Sub Xorl(firstShape As Object, secondShape As Object) '两个图形异或运算
　　Dim xorlResult As Object
　　Set xorlResult = firstShape.Xor(secondShape)
　　If Not xorlResult Is Nothing Then
　　Call drawRes(xorlResult)
　　Else
　　Label1.Caption = "差运算无返回结果..."
　　End If
　　End Sub
　　Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
　　On Error GoTo errorHandler
　　If shape1 Then
　　Set shp = trackShape
　　shape1 = False
　　Label1.Caption = "图形一已设置...请设置图形二..."
　　Else
　　Set shp2 = trackShape
　　If Option3.Value Then
　　Label1.Caption = "图形二已设置...执行差运算"
　　Call Difference(shp, shp2)
　　End If
　　If Option4.Value Then
　　Label1.Caption = "图形二已设置...执行交运算"
　　Call Intersect(shp, shp2)
　　End If
　　If Option5.Value Then
　　Label1.Caption = "图形二已设置...执行并运算"
　　Call Union(shp, shp2)
　　End If
　　If Option6.Value Then
　　Label1.Caption = "图形二已设置...执行异或运算"
　　Call Xorl(shp, shp2)
　　End If
　　End If
　　errorHandler:
　　If Err = 5001 Then
　　Debug.Print Err
　　MsgBox "您所输入的几何图形对当前操作不可用", vbInformation, "运算错误"
　　ElseIf Err > 0 Then
　　Debug.Print Err
　　End If
　　End Sub
　　在上面设计到TrackingLayer.AddEvent方法，具体是：
　　TrackingLayer.AddEvent 图形，图形显示符号特征