zdcut.vb

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

                    pFeat.Delete()
                    'pNewFeature.Shape = pOutputGeometry

                    '//输入新宗地的宗地号
                    pNewFeatleft = m_pZDFeatCls.CreateFeature
                    pNewFeatright = m_pZDFeatCls.CreateFeature

                    pNewFeatleft.Shape = leftGeom
                    pNewFeatright.Shape = rightGeom

                    m = pNewFeatleft.Fields.FindField(Consts.FieldsName.ZDH) '//向新合并的宗地输入宗地号
                    pNewFeatleft.Value(m) = pFrm.ZDHL
                    pNewFeatleft.Store() '//保存

                    m = pNewFeatright.Fields.FindField(Consts.FieldsName.ZDH) '//向新合并的宗地输入宗地号
                    pNewFeatright.Value(m) = pFrm.ZDHR
                    pNewFeatright.Store() '//保存

                    pGeoDef1 = Me.m_pJZDFeatCls.Fields.Field(m_pJZDFeatCls.FindField(m_pJZDFeatCls.ShapeFieldName)).GeometryDef
                    pGeoDef2 = Me.m_pJZXFeatCls.Fields.Field(m_pJZXFeatCls.FindField(m_pJZXFeatCls.ShapeFieldName)).GeometryDef

                    '//生成界址点
                    If IsNothing(m_pPointCollection) = False Then
                        '\\应分段生成界址线(LIU)
                        Dim pFromPt As IPoint, pToPt As IPoint, pLine As IPolyline
                        pFromPt = m_pPointCollection.Point(0)
                        If pGeoDef1.HasZ Then
                            pZaware = pFromPt
                            pZaware.ZAware = True
                            pFromPt.Z = 0.0
                        End If
                        If pGeoDef1.HasM Then
                            pMaware = pFromPt
                            pMaware.MAware = True
                        End If
                        '\\
                        For i = 1 To m_pPointCollection.PointCount - 2
                            pPoint = m_pPointCollection.Point(i)
                            If pGeoDef1.HasZ Then
                                pZaware = pPoint
                                pZaware.ZAware = True
                                pPoint.Z = 0.0
                            End If
                            If pGeoDef1.HasM Then
                                pMaware = pPoint
                                pMaware.MAware = True
                            End If
                            pNewFeat = Me.m_pJZDFeatCls.CreateFeature
                            pNewFeat.Shape = pPoint
                            pNewFeat.Store()
                            '\\分段生成界址线
                            pToPt = pPoint
                            pLine = New Polyline
                            pLine.FromPoint = pFromPt
                            pLine.ToPoint = pToPt
                            If pGeoDef2.HasZ Then
                                pZaware = pLine
                                pZaware.ZAware = True
                            End If
                            If pGeoDef2.HasM Then
                                pMaware = pLine
                                pMaware.MAware = True
                            End If
                            pNewFeat = m_pJZXFeatCls.CreateFeature
                            pNewFeat.Shape = pLine
                            pNewFeat.Store() '//生成界址线

                            pFromPt = pToPt '下一条
                        Next
                        '\\最后一条
                        pToPt = m_pPointCollection.Point(m_pPointCollection.PointCount - 1) '最后一个点
                        If pGeoDef1.HasZ Then
                            pZaware = pToPt
                            pZaware.ZAware = True
                            pToPt.Z = 0.0
                        End If
                        If pGeoDef1.HasM Then
                            pMaware = pToPt
                            pMaware.MAware = True
                        End If
                        '\\分段生成界址线
                        pLine = New Polyline
                        pLine.FromPoint = pFromPt
                        pLine.ToPoint = pToPt
                        If pGeoDef2.HasZ Then
                            pZaware = pLine
                            pZaware.ZAware = True
                        End If
                        If pGeoDef2.HasM Then
                            pMaware = pLine
                            pMaware.MAware = True
                        End If
                        pNewFeat = m_pJZXFeatCls.CreateFeature
                        pNewFeat.Shape = pLine
                        pNewFeat.Store() '//生成界址线
                        '\\完成
                    End If
                    '\\更新捕捉
                    Me.m_pSnapTool.UpdateSnap() '更新捕捉数据,是全部更新,应考虑效率问题,以后应优化2007.2.14
                    '=====================关闭对话框================
                    m_pFeedback = Nothing
                    m_bInUse = False
                    pNewFeat = Nothing
                    pTopotor = Nothing
                    'm_pCurrentPoint = Nothing
                    'm_pPreviousPoint = Nothing
                    '==============================================
                    'If Me.IsDialog Then
                    '    Me.IsDialog = False
                    '    Me.DialogForm.CurrentCreateTool = Nothing
                    '    Me.DialogForm.Close()
                    pWorkSpaceEdit.StopEditOperation()
                    MsgBox("宗地拆分成功！", MsgBoxStyle.OKOnly)
                    Me.DelecteHighLight()
                    m_pHookHelper.FocusMap.ClearSelection()
                    m_pHookHelper.ActiveView.Refresh()
                    '\\清除标志变量,以免与下次冲突(LIU)
                    Me.Flag = False
                End If
            Catch ex As System.Exception
                MsgBox("宗地拆分失败！", MsgBoxStyle.Exclamation + MsgBoxStyle.OKOnly)
                'MessageBox.Show(ex.Message)
                '\\出现错误,,则放弃保存(LIU)
                pWorkSpaceEdit.UndoEditOperation()
                Me.DelecteHighLight()
                Me.Flag = False
                '\\
                m_pFeedback = Nothing
                m_bInUse = False
                
                'm_pCurrentPoint = Nothing
                'm_pPreviousPoint = Nothing
                'End If
            End Try
        End Sub
        Public Sub SketchMouseDown(ByRef m_pMap As IMap, ByRef m_pFeedBack As IDisplayFeedback, ByRef m_pPointCollection As IPointCollection, ByRef m_bInUse As Boolean, ByVal x As Double, ByVal y As Double)
            '事件功能  根据选择条件，绘制相应图形
            '编写人    cgl
            '输入参数  无
            '返回参数  无
            ' Starts a new sketch or adds a point to an existing one, of a type
            ' determined by the current layer selected in the layers combo.

            ' Can only sketch on GeoFeature layer
            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 SketchMouseMove(ByRef m_pMap As IMap, ByRef m_pFeedBack As IDisplayFeedback, ByRef m_pPoint As IPoint, ByRef m_bInUse As Boolean, ByVal x As Double, ByVal y As Double)
            '事件功能  移动鼠标编辑
            '编写人    cgl
            '输入参数  无
            '返回参数  无
            If Not m_bInUse Or m_pFeedBack Is Nothing Then
                Return
            End If

            ' Move the feedback envelope and store the current mouse position
            Dim pActiveView As IActiveView = m_pMap
            '========================================
            m_pPoint = New Point
            m_pPoint.X = x
            m_pPoint.Y = y
            m_pPoint.Z = 0.0 '缺省值
            m_pFeedBack.MoveTo(m_pPoint)

        End Sub
        Public Sub EndSketch(ByRef m_pMap As IMap, ByRef m_pFeedBack As IDisplayFeedback, ByRef m_pPointCollection As IPointCollection, ByRef m_pPoint As IPoint, ByRef m_bInUse As Boolean)
            '事件功能  结束编辑
            '编写人    cgl
            '输入参数  无
            '返回参数  无
            Dim pGeom As IGeometry = Nothing
            Dim pPointCollection As IPointCollection = Nothing

            ' Create a new feature if (possible

            If TypeOf m_pFeedBack Is INewLineFeedback Then
                Dim pLineFeed As INewLineFeedback = m_pFeedBack
                pLineFeed.AddPoint(m_pPoint)

                pPolyLine = pLineFeed.Stop()
                pPointCollection = pPolyLine
                ''=========由于使用双击键在单击键的后面,所以多了一个点须删除======================
                pPointCollection.RemovePoints(pPointCollection.PointCount - 1, 1)

                If pPointCollection.PointCount < 2 Then
                    MessageBox.Show("一条直线上必须有两个以上的点.", "错误的线对象", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
                Else

                    pGeom = pPointCollection
                    m_pPointCollection = pGeom '//返回点集合
                End If

            End If
            '================================

            m_pFeedBack = Nothing
            m_bInUse = False
        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