⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 zdcut.vb

📁 基于ArcEngine用VB.net编写的地籍信息管理系统中实现宗地拆分功能的相关代码。在拆分宗地的同时传递历史宗地记录到数据库中。
💻 VB
📖 第 1 页 / 共 3 页
字号:
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 ZDCut  '//宗地拆分
        Inherits BaseTool

        Private m_pHookHelper As IHookHelper
        Private m_pMapControl As IMapControl3
        Private m_pMyEditorNew As myEditor.myEditorNew
        Private m_pMap As IMap
        Private m_pWorkspace As IWorkspace
        Private m_pZDLayer As ILayer
        Private m_pZDFeatCls As IFeatureClass
        Private m_pJZDFeatCls As IFeatureClass
        Private m_pJZXFeatCls As IFeatureClass
        Private m_pMenu As IToolbarMenu
        Public IsDialog As Boolean '判断是否弹出对话框
        Public DialogForm As JZDInput '弹出对话框
        '============================================
        'Private m_pCurrentPoint As IPoint '存放当前节点
        'Private m_pPreviousPoint As IPoint '存放当前节点的前一个节点
        '===============================================
        Private m_pPoint As IPoint
        Private pPolyLine As IPolyline

        Private m_pSnapTool As SnappingTool '捕捉对象

        Private m_pFeedback As IDisplayFeedback
        Private m_pPointCollection As IPointCollection
        Private m_bInUse As Boolean
        Private m_pTopology As ITopology2
        Private m_pTopologyGraph As ITopologyGraph

        Private Flag As Boolean
        Private pFeat As IFeature
        Private m_pElements As ArrayList '传入所编辑要素的图形要素,与FEAT要素是一一对应的
        Private m_pFillSymbol As ISimpleFillSymbol
        Private SelectFeatNum As Integer

        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
            Dim pTopologyLayer As ITopologyLayer

            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
                ElseIf pLayer.Name = Consts.LayersName.jzdLayerName And TypeOf (pLayer) Is IFeatureLayer Then '//找到界址点图层
                    pFeatLyr = pLayer
                    Me.m_pJZDFeatCls = pFeatLyr.FeatureClass
                ElseIf pLayer.Name = Consts.LayersName.jzxLayerName And TypeOf (pLayer) Is IFeatureLayer Then '//找到界址线图层
                    pFeatLyr = pLayer
                    Me.m_pJZXFeatCls = pFeatLyr.FeatureClass
                ElseIf pLayer.Name = Consts.LayersName.CurrentTopoName And TypeOf (pLayer) Is ITopologyLayer Then  '//找到拓扑关系图层
                    pTopologyLayer = pLayer
                    Me.m_pTopology = pTopologyLayer.Topology
                End If
            Next
            m_pMenu.AddItem(New myInputAbsoluteXY, , , , esriCommandStyles.esriCommandStyleTextOnly)
            m_pMenu.AddItem(New myCancelInput, , , True, esriCommandStyles.esriCommandStyleTextOnly)
            m_pMenu.SetHook(Me) '与当前的创建对象建立联系

        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 pmyEditorNew As myEditor.myEditorNew)
            MyBase.New()
            m_pHookHelper = New HookHelper
            m_pMyEditorNew = pmyEditorNew
            m_pSnapTool = m_pMyEditorNew.SnapTool
            m_pMapControl = m_pMyEditorNew.MapControl

            m_pMenu = New ToolbarMenu
            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的属性"生成"的值改为"嵌入的资源",否则会出错.
            SelectFeatNum = 0  '//初始化要素选择数
            Me.m_pElements = New ArrayList  '//初始化数组
            Flag = False
        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 Flag = False Then

                            If MsgBox("确定拆分这块宗地吗?", MsgBoxStyle.OKCancel) = MsgBoxResult.Cancel Then
                                '\\取消则重新选择(LIU)
                                Flag = False
                            Else
                                pFeat = Me.SelectZDFeature(X, Y)
                                Me.GetSelectFeatHighLight(pFeat)
                                'GetSelectFeatHighLight(pFeat)
                                Flag = True
                            End If
                        Else
                            Me.SketchMouseDown(m_pMap, m_pFeedback, m_pPointCollection, m_bInUse, m_pSnapTool.GetSnappingPoint.X, m_pSnapTool.GetSnappingPoint.Y)
                        End If

                    Case 2 '右键
                        If Flag Then '只有选择宗地后才能弹出菜单(LIU)
                            m_pMenu.PopupMenu(X, Y, m_pMapControl.hWnd)
                        End If
                End Select
            Catch ex As System.Exception
                MessageBox.Show(ex.Message)
            End Try
        End Sub

        Public Overrides Sub OnMouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Integer, ByVal Y As Integer)
            m_pSnapTool.OnMouseMove(X, Y)
            '================================
            Me.SketchMouseMove(m_pMap, m_pFeedback, m_pPoint, m_bInUse, m_pSnapTool.GetSnappingPoint.X, m_pSnapTool.GetSnappingPoint.Y)
        End Sub
        '//结束画线,拆分宗地——BXD
        Public Overrides Sub OnDblClick()
            Dim pGeom As IGeometry
            Dim leftGeom As IGeometry
            Dim rightGeom As IGeometry
            Dim pTopotor As ITopologicalOperator
            Dim pNewFeature As IFeature
            Dim pNewFeatleft As IFeature
            Dim pNewFeatright As IFeature
            Dim m As Integer
            Dim pWorkSpaceEdit As IWorkspaceEdit
            Dim pFeatureWorkspace As IFeatureWorkspace
            Dim pFeatureClass As IFeatureClass
            Dim pReTab As ITable
            Dim pNewFeat As IFeature
            Dim pRow As IRow
            Dim i, j, k As Integer

            Dim pGeoDef1 As IGeometryDef, pGeoDef2 As IGeometryDef
            Dim pZaware As IZAware
            Dim pMaware As IMAware
            Dim pPoint As IPoint
            Try
                Me.EndSketch(m_pMap, m_pFeedback, m_pPointCollection, m_pPoint, m_bInUse)
                '\\关闭输入对话框(liu)
                If Me.IsDialog Then
                    Me.DialogForm.Close()
                End If
                Dim pFrm As New ZDCutInfoInput
                pFrm.ShowDialog()

                pWorkSpaceEdit = Me.m_pWorkspace
                If pWorkSpaceEdit.IsBeingEdited Then
                    pWorkSpaceEdit.StartEditOperation()
                    '\\打开与历史相关的要素类
                    pFeatureWorkspace = Me.m_pWorkspace
                    pFeatureClass = pFeatureWorkspace.OpenFeatureClass(Consts.LayersName.zdHistoryFeatclsName) '//打开ZDHistory要素类
                    pReTab = pFeatureWorkspace.OpenTable(Consts.LayersName.zdRelationTableName) '//打开关系表
                    If IsNothing(pFeatureClass) Or IsNothing(pReTab) Then
                        MsgBox("数据库中没有建立存放历史数据所需的表或要素类!请查看数据库结构!", , "错误提示")
                        Return
                    End If

                    '//左边宗地
                    pNewFeat = pFeatureClass.CreateFeature
                    pNewFeat.Shape = pFeat.ShapeCopy '//传递宗地的空间字段
                    m = pFeat.Fields.FindField(Consts.FieldsName.ZDH)
                    pRow = pReTab.CreateRow
                    pRow.Value(1) = pFeat.Value(m)
                    pRow.Value(2) = pFrm.ZDHL          '//将左边宗地号传到关系表中
                    pRow.Value(3) = pFrm.AlterTime
                    pRow.Value(4) = pFrm.AlterPerson
                    pRow.Value(5) = "C"
                    pRow.Store()
                    pRow = pReTab.CreateRow
                    pRow.Value(1) = pFeat.Value(m)
                    pRow.Value(2) = pFrm.ZDHR         '//将右边宗地号传到关系表中
                    pRow.Value(3) = pFrm.AlterTime
                    pRow.Value(4) = pFrm.AlterPerson
                    pRow.Value(5) = "C"
                    pRow.Store()
                    For j = 0 To pNewFeat.Fields.FieldCount - 1  '//传递选中宗地的属性值到历史表中

                        If pNewFeat.Fields.Field(j).Editable And pNewFeat.Fields.Field(j).Type <> esriFieldType.esriFieldTypeGeometry Then

                            k = pFeat.Fields.FindFieldByAliasName(pNewFeat.Fields.Field(j).AliasName)
                            pNewFeat.Value(j) = pFeat.Value(k)
                        End If
                    Next
                    pNewFeat.Store()

                    '//拆分
                    pGeom = pFeat.ShapeCopy
                    pTopotor = pGeom
                    pTopotor.Cut(pPolyLine, leftGeom, rightGeom)

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -