zddifferent.vb

基于ArcEngine用VB.net编写的地籍信息管理系统中实现宗地摘桃子功能的相关代码。

Imports ESRI.ArcGIS.ToolbarControl
Imports ESRI.ArcGIS.SystemUI
Imports ESRI.ArcGIS.Carto
Imports ESRI.ArcGIS.MapControl
Imports ESRI.ArcGIS.TOCControl
Imports ESRI.ArcGIS.esriSystem
Imports ESRI.ArcGIS.Display
Imports ESRI.ArcGIS.Geometry
Imports ESRI.ArcGIS.Geodatabase
Imports ESRI.ArcGIS.DataSourcesGDB
Imports ESRI.ArcGIS.DataSourcesFile

Imports Microsoft.VisualBasic
Imports System
Imports ESRI.ArcGIS.Geometry.esriGeometryType    '//添加类型

Imports System.Windows.Forms
Imports System.Data
Imports System.Runtime.InteropServices

Imports ESRI.ArcGIS.ControlCommands
Imports ESRI.ArcGIS.Utility.BaseClasses
Namespace myZDEditor
    Public Class ZDDifferent
        Inherits BaseTool

        Private m_pHookHelper As IHookHelper
        Private m_pMapControl As IMapControl3
        Private m_pMap As IMap
        Private m_pWorkspace As IWorkspace
        Private m_pZDLayer As ILayer
        Private m_pZDFeatCls As IFeatureClass
        Private m_pFlag As Boolean
        Private m_pFirstFeat As IFeature
        Private m_pSecondFeat As IFeature

        Public Overrides Sub OnCreate(ByVal hook As Object)
            m_pHookHelper.Hook = hook

            m_pMap = m_pHookHelper.FocusMap
            Dim pLayer As ILayer
            Dim i As Integer
            Dim pFeatLyr As IFeatureLayer
            Dim pFeatCls As IFeatureClass

            For i = 0 To m_pMap.LayerCount - 1
                pLayer = m_pMap.Layer(i)
                If pLayer.Name = Consts.LayersName.zdLayerName And TypeOf (pLayer) Is IFeatureLayer Then '//找到宗地图层
                    m_pZDLayer = pLayer
                    pFeatLyr = pLayer
                    pFeatCls = pFeatLyr.FeatureClass
                    Me.m_pZDFeatCls = pFeatCls
                    Me.m_pWorkspace = pFeatCls.FeatureDataset.Workspace
                End If
            Next
        End Sub
        Public Overrides ReadOnly Property Enabled() As Boolean
            Get
                '======================================
                If Me.m_pWorkspace Is Nothing Then Return False
                Dim pWsEdit As IWorkspaceEdit = Me.m_pWorkspace
                Return pWsEdit.IsBeingEdited
                '======================================

            End Get
        End Property
        Public Sub New(ByVal pMapControl As IMapControl3)
            MyBase.New()
            '\\
            m_pHookHelper = New HookHelper
            m_pMapControl = pMapControl
            '\\
            MyBase.m_bitmap = New System.Drawing.Bitmap((GetType(ZDMerger).Assembly.GetManifestResourceStream("地籍管理信息系统.EditSelect.bmp")))
            MyBase.m_cursor = New System.windows.forms.Cursor((GetType(ZDMerger).Assembly.GetManifestResourceStream("地籍管理信息系统.myEditSelect.cur"))) '注意要将MYCURSOR.CUR的属性"生成"的值改为"嵌入的资源",否则会出错.

        End Sub
        Public Overrides Sub OnMouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Integer, ByVal Y As Integer)
            Dim pFeatCls As IFeatureClass
            Dim pFeatLyr As IFeatureLayer
            Try
                Select Case Button
                    Case 1 '左键
                        If IsNothing(Me.m_pFirstFeat) Then
                            '//
                            Me.m_pFirstFeat = Me.SelectZDFeature(X, Y)
                            '//
                            MsgBox("已选择母宗地,   请选择子宗地!", , "提示")
                        Else
                            Me.m_pSecondFeat = Me.SelectZDFeature(X, Y)
                        End If


                    Case 2 '右键

                End Select
            Catch ex As System.Exception
                MessageBox.Show(ex.Message)
            End Try
        End Sub
        Private Function SelectZDFeature(ByVal x As Integer, ByVal y As Integer) As IFeature
            Dim pPoint As IPoint
            Dim pDArray As IArray
            Dim pIdentify As IIdentify
            Dim pFeatureIdentifyObj As IFeatureIdentifyObj
            Dim pIdentifyObj As IIdentifyObj
            Dim pRowIdentifyObj As IRowIdentifyObject
            Dim pActiveView As IActiveView
            Dim pOperater As ITopologicalOperator
            Dim pGeom As IGeometry
            Dim pFeature As IFeature

            pIdentify = Me.m_pZDLayer

            pActiveView = Me.m_pMap
            pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)

            Dim length As Double = Me.ConvertPixelsToMapUnits(pActiveView, 4)
            pOperater = pPoint
            pGeom = pOperater.Buffer(length)     '//对屏幕上点击得到的点创建缓冲

            pDArray = pIdentify.Identify(pGeom)
            'Get the FeatureIdentifyObject
            If Not pDArray Is Nothing Then
                ''MsgBox(pIDArray.Count)
                If Not IsNothing(Me.m_pFirstFeat) Then '当母宗不为空时,判断不能重复选
                    Dim i As Integer
                    For i = 0 To pDArray.Count - 1
                        pFeatureIdentifyObj = pDArray.Element(i)
                        pRowIdentifyObj = pFeatureIdentifyObj
                        pFeature = pRowIdentifyObj.Row '查到了一个要素类
                        If Me.m_pFirstFeat.OID <> pFeature.OID Then
                            Exit For
                        End If
                    Next
                Else
                    pFeatureIdentifyObj = pDArray.Element(0)
                    pRowIdentifyObj = pFeatureIdentifyObj
                    pFeature = pRowIdentifyObj.Row '查到了一个要素类
                End If
                pIdentifyObj = pFeatureIdentifyObj
                pIdentifyObj.Flash(pActiveView.ScreenDisplay)      '//闪烁显示对应的Feature 
                '//不需要闪烁，只是加一个绿色的外框-bxd
                'Feature property of FeatureIdentifyObject has write only access   
                Return pFeature
            Else
                Return Nothing
            End If
        End Function
        Private Function ConvertPixelsToMapUnits(ByVal pActiveView As IActiveView, ByVal pixelUnits As Double) As Double
            ' Uses the ratio of the size of the map in pixels to map units to do the conversion
            Dim p1 As IPoint = pActiveView.ScreenDisplay.DisplayTransformation.VisibleBounds.UpperLeft
            Dim p2 As IPoint = pActiveView.ScreenDisplay.DisplayTransformation.VisibleBounds.UpperRight
            Dim x1 As Integer, x2 As Integer, y1 As Integer, y2 As Integer
            pActiveView.ScreenDisplay.DisplayTransformation.FromMapPoint(p1, x1, y1)
            pActiveView.ScreenDisplay.DisplayTransformation.FromMapPoint(p2, x2, y2)
            Dim pixelExtent As Double = x2 - x1
            Dim realWorldDisplayExtent As Double = pActiveView.ScreenDisplay.DisplayTransformation.VisibleBounds.Width
            Dim sizeOfOnePixel As Double = realWorldDisplayExtent / pixelExtent
            Return pixelUnits * sizeOfOnePixel
        End Function

        Public Overrides Sub OnDblClick()
            If IsNothing(Me.m_pFirstFeat) Then
                MsgBox("请选择母宗!", , "提示")
                Exit Sub
            End If
            '\\
            If IsNothing(Me.m_pSecondFeat) Then
                MsgBox("请选择子宗!", , "提示")
                Exit Sub
            End If
            If MsgBox("是否执行挑桃子操作?", MsgBoxStyle.YesNo, "提示") = MsgBoxResult.No Then
                Me.m_pFirstFeat = Nothing
                Me.m_pSecondFeat = Nothing
            End If

            '\\
            '\\开始挑桃子
            Dim pWsEdit As IWorkspaceEdit = Me.m_pWorkspace
            Dim pFirstGeo As IGeometry
            Dim pSecondGeo As IGeometry
            Dim pTopoOperator As ITopologicalOperator
            '\\
            Try
                If pWsEdit.IsBeingEdited Then
                    '\\
                    pWsEdit.StartEditOperation()
                    '\\
                    pFirstGeo = Me.m_pFirstFeat.Shape
                    pSecondGeo = Me.m_pSecondFeat.Shape
                    pTopoOperator = pFirstGeo

                    pFirstGeo = pTopoOperator.Difference(pSecondGeo) '执行操作
                    '\\更新
                    Me.m_pFirstFeat.Shape = pFirstGeo
                    Me.m_pFirstFeat.Store()

                    pWsEdit.StopEditOperation()
                    '\\闪烁更新的母宗，并提示结束
                    Dim myColor As IColor
                    myColor = New RgbColor
                    myColor.RGB = RGB(255, 0, 0)
                    Dim polygonsym As ISimpleFillSymbol
                    polygonsym = New SimpleFillSymbol
                    polygonsym.Color = myColor
                    Me.m_pMapControl.FlashShape(pFirstGeo, 1, 500, polygonsym)

                    MsgBox("操作结束!", , "提示")

                    Me.m_pFirstFeat = Nothing
                    Me.m_pSecondFeat = Nothing
                End If
            Catch ex As Exception
                MsgBox(ex.Message, , "错误提示")
            End Try


        End Sub
    End Class
End Namespace