📄 zdcut.vb
字号:
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 + -