Dim shape1 As Boolean '判斷是否已經(jīng)獲得一個幾何形狀
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
'創(chuàng)建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 '根據(jù)用戶的選擇在trackinglayer上創(chuàng)建圖形
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 = "差運算無返回結(jié)果..."
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 = "交運算無返回結(jié)果..."
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 = "差運算無返回結(jié)果..."
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 = "差運算無返回結(jié)果..."
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 = "圖形一已設(shè)置...請設(shè)置圖形二..."
Else
Set shp2 = trackShape
If Option3.Value Then
Label1.Caption = "圖形二已設(shè)置...執(zhí)行差運算"
Call Difference(shp, shp2)
End If
If Option4.Value Then
Label1.Caption = "圖形二已設(shè)置...執(zhí)行交運算"
Call Intersect(shp, shp2)
End If
If Option5.Value Then
Label1.Caption = "圖形二已設(shè)置...執(zhí)行并運算"
Call Union(shp, shp2)
End If
If Option6.Value Then
Label1.Caption = "圖形二已設(shè)置...執(zhí)行異或運算"
Call Xorl(shp, shp2)
End If
End If
errorHandler:
If Err = 5001 Then
Debug.Print Err
MsgBox "您所輸入的幾何圖形對當(dāng)前操作不可用", vbInformation, "運算錯誤"
ElseIf Err > 0 Then
Debug.Print Err
End If
End Sub
在上面設(shè)計到TrackingLayer.AddEvent方法，具體是：
TrackingLayer.AddEvent 圖形，圖形顯示符號特征
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
'創(chuàng)建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 '根據(jù)用戶的選擇在trackinglayer上創(chuàng)建圖形
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 = "差運算無返回結(jié)果..."
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 = "交運算無返回結(jié)果..."
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 = "差運算無返回結(jié)果..."
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 = "差運算無返回結(jié)果..."
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 = "圖形一已設(shè)置...請設(shè)置圖形二..."
Else
Set shp2 = trackShape
If Option3.Value Then
Label1.Caption = "圖形二已設(shè)置...執(zhí)行差運算"
Call Difference(shp, shp2)
End If
If Option4.Value Then
Label1.Caption = "圖形二已設(shè)置...執(zhí)行交運算"
Call Intersect(shp, shp2)
End If
If Option5.Value Then
Label1.Caption = "圖形二已設(shè)置...執(zhí)行并運算"
Call Union(shp, shp2)
End If
If Option6.Value Then
Label1.Caption = "圖形二已設(shè)置...執(zhí)行異或運算"
Call Xorl(shp, shp2)
End If
End If
errorHandler:
If Err = 5001 Then
Debug.Print Err
MsgBox "您所輸入的幾何圖形對當(dāng)前操作不可用", vbInformation, "運算錯誤"
ElseIf Err > 0 Then
Debug.Print Err
End If
End Sub
在上面設(shè)計到TrackingLayer.AddEvent方法，具體是：
TrackingLayer.AddEvent 圖形，圖形顯示符號特征