zdcut.vb

基于ArcEngine用VB.net编写的地籍信息管理系统中实现宗地拆分功能的相关代码。在拆分宗地的同时传递历史宗地记录到数据库中。

            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)

                pFeatureIdentifyObj = pDArray.Element(0)
                pIdentifyObj = pFeatureIdentifyObj
                'pIdentifyObj.Flash(pActiveView.ScreenDisplay)      '//闪烁显示对应的Feature 
                ''//不需要闪烁，只是加一个绿色的外框-bxd
                'Feature property of FeatureIdentifyObject has write only access   
                pRowIdentifyObj = pFeatureIdentifyObj
                pFeature = pRowIdentifyObj.Row '查到了一个要素类
                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
        '=====================输入绝对坐标=============================
        Private Class myInputAbsoluteXY
            Inherits BaseCommand

            Private m_pTool As myZDEditor.ZDCut  '当前的创建工具

            Public Overrides Sub OnCreate(ByVal hook As Object)
                m_pTool = hook
            End Sub

            Public Overrides Sub OnClick()
                If m_pTool.IsDialog Then

                    m_pTool.DialogForm.Text = "输入绝对坐标"
                    m_pTool.DialogForm.TextBox1.Focus()

                Else
                    m_pTool.DialogForm = New JZDInput
                    m_pTool.IsDialog = True
                    m_pTool.DialogForm.CurrentCreateTool = m_pTool
                    m_pTool.DialogForm.Text = "输入绝对坐标"
                    m_pTool.DialogForm.Show()
                    m_pTool.DialogForm.TextBox1.Focus()
                End If
            End Sub
            Public Overrides ReadOnly Property Tooltip() As String
                Get
                    Return "输入绝对坐标"
                End Get
            End Property

            Public Overrides ReadOnly Property Name() As String
                Get
                    Return "输入绝对坐标"
                End Get
            End Property

            Public Overrides ReadOnly Property Message() As String
                Get
                    Return "输入绝对坐标"
                End Get
            End Property

            Public Overrides ReadOnly Property Caption() As String
                Get
                    Return "输入绝对坐标"
                End Get
            End Property
        End Class
        Private Class myCancelInput '取消全部输入
            Inherits BaseCommand

            Private m_pTool As myZDEditor.ZDCut   '当前的创建工具

            Public Overrides Sub OnCreate(ByVal hook As Object)
                m_pTool = hook
            End Sub

            Public Overrides Sub OnClick()
                m_pTool.CancelInput() '取消全部输入
            End Sub
            Public Overrides ReadOnly Property Tooltip() As String
                Get
                    Return "取消全部输入"
                End Get
            End Property

            Public Overrides ReadOnly Property Name() As String
                Get
                    Return "取消全部输入"
                End Get
            End Property

            Public Overrides ReadOnly Property Message() As String
                Get
                    Return "取消全部输入"
                End Get
            End Property

            Public Overrides ReadOnly Property Caption() As String
                Get
                    Return "取消全部输入"
                End Get
            End Property

        End Class
        Public Sub InputXY(ByVal x As Double, ByVal y As Double) '对于键盘输入时的处理,主要用于窗体的调用
            '=============================================
            Dim pActiveView As IActiveView = m_pMap
            Dim pPoint As IPoint = New Point '= pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
            pPoint.X = x
            pPoint.Y = y
            pPoint.Z = 0.0 '缺省值

            ' if (this is a fresh sketch) create an appropriate feedback object,
            ' otherwise extent the existing feedback
            If Not m_bInUse Then
                m_bInUse = True
                m_pFeedback = New NewLineFeedback
                Dim pLineFeed As INewLineFeedback = m_pFeedback
                pLineFeed.Start(pPoint)

                If Not m_pFeedback Is Nothing Then
                    m_pFeedback.Display = pActiveView.ScreenDisplay
                End If
            Else
                If TypeOf m_pFeedback Is INewLineFeedback Then
                    Dim pLineFeed As INewLineFeedback = m_pFeedback
                    pLineFeed.AddPoint(pPoint)
                End If
            End If
        End Sub
        Public Sub CancelInput() '取消全部输入
            '=================================
            m_bInUse = False
            m_pFeedback = Nothing
            '=====================关闭对话框================
            If Me.IsDialog Then
                Me.IsDialog = False
                Me.DialogForm.CurrentCreateTool = Nothing
                Me.DialogForm.Close()
            End If
            Dim pAV As IActiveView
            pAV = m_pMap
            pAV.PartialRefresh(esriViewDrawPhase.esriViewForeground, Nothing, Nothing)

        End Sub
        Private Sub GetSelectFeatHighLight(ByVal myFeat As IFeature)
            Dim ZDPolygon As IPolygon
            Dim pPolygonElt As IFillShapeElement
            Dim pColor As IRgbColor
            Dim pElt As IElement
            Dim pGC As IGraphicsContainer

            pColor = New RgbColor
            pColor.RGB = RGB(0, 255, 0)

            Dim pOutline As ILineSymbol
            pOutline = New SimpleLineSymbol
            pOutline.Width = 2
            pOutline.Color = pColor

            m_pFillSymbol = New SimpleFillSymbol
            m_pFillSymbol.Outline = pOutline
            m_pFillSymbol.Style = esriSimpleFillStyle.esriSFSHollow

            pElt = New PolygonElement

            pElt.Geometry = myFeat.ShapeCopy
            pPolygonElt = pElt
            pPolygonElt.Symbol = m_pFillSymbol

            pGC = m_pMap
            If Not pElt Is Nothing Then
                Me.m_pElements.Add(pElt)
            End If

            pGC.AddElement(Me.m_pElements(SelectFeatNum), SelectFeatNum)
            SelectFeatNum += 1

            Dim pActive As IActiveView
            pActive = m_pMap
            pActive.PartialRefresh(esriViewDrawPhase.esriViewGraphics, Nothing, Nothing)

            'pPolygonElt.Symbol = pPolygonSymbol


        End Sub
        Private Sub DelecteHighLight()
            Dim i As Integer
            Dim pGC As IGraphicsContainer
            Dim pAV As IActiveView
            pGC = m_pMap
            pAV = m_pMap

            For i = 0 To Me.m_pElements.Count - 1
                '================================
                pGC.DeleteElement(Me.m_pElements(i))
            Next

            Me.m_pElements.Clear() '//清空数组 
            SelectFeatNum = 0 '//清空被选要素数
            pAV.Refresh()

        End Sub

        Protected Overrides Sub Finalize()
            MyBase.Finalize()
        End Sub
    End Class
End Namespace