complus
路人甲
路人甲
  • 注册日期2005-01-19
  • 发帖数20
  • QQ
  • 铜币193枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:2659回复:2

arcgis中如何去除重复点要素的问题

楼主#
更多 发布于:2007-07-03 14:18
<P>各位大侠好</P>
<P>小弟在此有一问题</P>
<P>如何能够在arcgis中去除重复的点呢</P>
<P>没有现成的工具</P>
<P>用拓扑规则也不行(因为没有point-point的拓扑规则)(当然,我也不会写)</P>
<P>只能编程了看来</P>
<P>有哪位做过的 请指教一二</P>
<P>在此感谢之至</P>
喜欢0 评分0
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15951
  • QQ
  • 铜币25345枚
  • 威望15368点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
1楼#
发布于:2007-07-03 14:50
<PRE>下面的代码可以帮你完成任务,不过是基于arcgis8.x的代码,你可能需要转换一下,</PRE><PRE>使用方法:在vba里面使用,具体就不说了,可以看看顶贴的教程</PRE><PRE> </PRE><PRE><PRE>Option Explicit
Sub Test()
    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument
    
    SelectPoints pMxDoc.FocusMap.Layer(0)
    
    ' refresh the selection screen cache
    Dim pAV As IActiveView
    Set pAV = pMxDoc.FocusMap
    Dim lCacheID As Long
    lCacheID = pAV.ScreenCacheID(esriViewGeoSelection, Nothing)
    pAV.ScreenDisplay.Invalidate Nothing, True, lCacheID

End Sub

Sub SelectPoints(pFLayer As IFeatureLayer)
    Dim lOIDs() As Long, lCount As Long
    QueryPoints pFLayer.FeatureClass, lOIDs, lCount
    
    Dim pFSel As IFeatureSelection
    Set pFSel = pFLayer
    pFSel.Clear
    If lCount > 0 Then
        pFSel.SelectionSet.AddList lCount, lOIDs(0)
    End If
End Sub

Sub QueryPoints(pFC As IFeatureClass, lOIDs() As Long, _
                ByRef lCount As Long)
    '
    ' sets an array of OID's with features that are intersected
    ' by a feature in the same featureclass with a smaller OID
    '
    Dim pFI2 As IFeatureIndex2
    Set pFI2 = New FeatureIndex
    
    Set pFI2.FeatureClass = pFC
    Dim pGDS As IGeoDataset
    Set pGDS = pFC
    pFI2.Index Nothing, pGDS.Extent
    Debug.Print "index built"
    Dim pIQ2 As IIndexQuery2
    Set pIQ2 = pFI2
    
    Dim pFCur As IFeatureCursor
    Set pFCur = pFC.Search(Nothing, False)
    
    Dim pDict As Scripting.Dictionary
    Set pDict = New Scripting.Dictionary
    
    Dim pFeat As IFeature, l As Long, vOID As Variant, sMsg As String
    Set pFeat = pFCur.NextFeature
    Dim vIntersects As Variant
    Do Until pFeat Is Nothing
        pIQ2.IntersectedFeatures pFeat.Shape, vIntersects
        If UBound(vIntersects) > 0 Then
            For Each vOID In vIntersects
                If vOID > pFeat.OID Then
                    If Not pDict.Exists(CStr(vOID)) Then
                        pDict.Add CStr(vOID), 0
                    End If
                End If
            Next vOID
        End If
        Set pFeat = pFCur.NextFeature
        l = l + 1
        If l Mod 100 = 0 Then
            sMsg = l ; " rows processed, pointcount: " ; pDict.Count
            Application.StatusBar.Message(0) = sMsg
            Debug.Print sMsg
        End If
    Loop
    
    ' load the array
    l = 0
    If pDict.Count > 0 Then
        ReDim lOIDs(pDict.Count - 1)
        For Each vOID In pDict.Keys
            lOIDs(l) = CLng(vOID)
            l = l + 1
        Next vOID
    End If
    lCount = pDict.Count
End Sub

</PRE> </PRE>
GIS麦田守望者,期待与您交流。
举报 回复(0) 喜欢(0)     评分
complus
路人甲
路人甲
  • 注册日期2005-01-19
  • 发帖数20
  • QQ
  • 铜币193枚
  • 威望0点
  • 贡献值0点
  • 银元0个
2楼#
发布于:2007-07-03 15:04
<P>多谢多谢</P>
<P>我试试</P>
<P>真的多谢了</P>
举报 回复(0) 喜欢(0)     评分
游客

返回顶部