Помогите сделать хитрый запрос

0 голосов
спросил 26 Окт, 06 от beznoschenko (900 баллов) в категории Программные продукты Esri
Есть полигональный слой зданий, некоторые из зданий повторяют собой по форме друг друга, я хочу сделать запрос на выборку по местоположению объектов слоя если они находяться друг внутри друга, а как это сделать сомневаюсь....может кто поможет?

16 Ответы

0 голосов
ответил 31 Окт, 06 от geologic (39,860 баллов)
Не совсем понятна задача, все-таки. Найти внутри каких полигонов есть еще полигон, по форме подобный первому? Это называется клоном?
 
Если да, и расстояние между соответствующими вершинами "клонированных" полигонов малО (меньше длины ребер полигонов), то и правда можно пытаться через дубликаты этот вопрос решить. Я не уверен точно, какие средства не удаляют дубликаты, а откладывают их "в другой слой". Возможно, TypeConvert, т.к. ни Build ни ET этого не делают.
 
Вручную задача может быть решена так: 1) разложить полигоны на точки. 2) проанализировать точки - найти смежные пары, запросом по координатам с некоторым допуском. 3) Сопоставить все группы точек (бывшие полигоны). те пары из них, в которых все точки смежные, это и будет пара полигонов-клонов. В принципе, в такой постановке это должно решаться через SQL по таблице координат.
 
Tipeconvert... Возможно tYpeconvert имеется в виду, хронусовский? Можно глянуть здесь:
0 голосов
ответил 31 Окт, 06 от Vadim (28,120 баллов)
0 голосов
ответил 31 Окт, 06 от Гость (210,080 баллов)
У меня в запасниках есть чей-то скрипт (не помню где скачал). Я его толком не тестил, но он вроде вылавливает дубли объектов. Это, конечно при условии, что вся проблема только в поиске дублей. Вот текст скрипта:

'////////////////////////////////////////////
'Name: DetectDuplicateItems
'©WedMC
'////////////////////////////////////////////

'НАЧАЛО ПРОГРАММЫ
'работаем с первой активной темой вида
theTheme = av.GetActiveDoc.GetActiveThemes.Get(0)
theFtab = theTheme.GetFtab
'начало редактирования таблицы
theFtab.SetEditable(true)
'ищем поле
err_fld = theFtab.FindField("SAME_AS")
'если его нет - создаем и добавляем в таблицу
if (err_fld = nil) then
err_fld = Field.Make("SAME_AS",#FIELD_DECIMAL,16,0)
theFtab.AddFields({err_fld})
end
'определяем поле "Shape"
sField = theFtab.FindField("Shape")
'определяем число строк в таблице
recCou= theFtab.GetNumRecords.AsString
'инициализируем счетчик ошибок
errCou = 0
'для всех записей в таблице
for each rec in 0..(theFtab.GetNumRecords-1)
'рапорт о процессе работы
System.BasicEcho("record #"++rec.Asstring++"of"++recCou,TRUE)
'текущий шейп
sh = theFtab.ReturnValue(sField,rec)
'выборка в таблице по текущему шейпу
theFTab.SelectByShapes ({sh}, #VTAB_SELTYPE_NEW)
'для всех выбранных элементов
for each r in theFtab.GetSelection
'если это не он сам
if (r<>rec) then
'и если такой-же как и текущий
if (theFtab.ReturnValue(sField,r) = sh) then
'увеличиваем счетчик ошибок
errCou = errCou+1
'заносим значение id дубликата в поле "SAME_AS"
theFtab.SetValue(err_fld,r,rec+1)
end
end
end
end
'конец редактирования таблицы
theFtab.SetEditable(false)
'рапорт о конце работы
MsgBox.Info(errCou.AsString++"duplicated ithems found","")
'КОНЕЦ ПРОГРАММЫ
0 голосов
ответил 31 Окт, 06 от Гость (210,080 баллов)
Забыл добавить - это для Арквью..
0 голосов
ответил 05 Ноя, 06 от Grigoriy (127,020 баллов)

' Проставляет в последнее поле выделенного слоя 1,
' для записей с одинаковой геометрией
' Работает только с шейп-файлами.

Public Sub MarkDup()
    Dim mx As IMxDocument
    Dim pFL As IFeatureLayer
    Dim sfield As String
    Dim shpfld As String
    Dim shpfldind As Integer
    Dim oidfldind As Integer
   
    Set mx = ThisDocument
    Set pFL = mx.SelectedLayer
    shpfld = pFL.FeatureClass.ShapeFieldName
    shpfldind = pFL.FeatureClass.Fields.FindField(pFL.FeatureClass.ShapeFieldName)
    oidfldind = pFL.FeatureClass.Fields.FindField(pFL.FeatureClass.OIDFieldName)
   
    If pFL Is Nothing Then Exit Sub
   
    Dim pFt As IFeature
    Dim pftCur As IFeatureCursor
    Dim pFt2 As IFeature
    Dim pFtCol As IFeatureCursor
    Dim pSQ As ISpatialFilter
    Dim pRelOp As IRelationalOperator
    Dim pGeom As IGeometry
    Dim n, n1 As Integer
   
    Set pftCur = pFL.Search(Nothing, False)
    Set pFt = pftCur.NextFeature
    Do Until pFt Is Nothing
        Set pSQ = New SpatialFilter
        pSQ.GeometryField = shpfld
        Set pGeom = pFt.ShapeCopy
        Set pSQ.Geometry = pGeom
        sfield = pFt.Fields.Field(pFt.Fields.FieldCount - 1).Name
        'pSQ.SpatialRel = esriSpatialRelContains
        pSQ.SpatialRel = esriSpatialRelIntersects
        Set pFtCol = pFL.Search(pSQ, False)
        Set pFt2 = pFtCol.NextFeature
        'Set pFt2 = pFtCol.NextFeature
        Do Until pFt2 Is Nothing
            Set pRelOp = pFt2.Shape
            n = pFt2.Value(oidfldind)
            n1 = pFt.Value(oidfldind)
            If pFt2.Value(oidfldind) <> pFt.Value(oidfldind) Then
                If pRelOp.Equals(pGeom) Then
                    If pFt2.Value(pFL.FeatureClass.Fields.FieldCount - 1) <> 1 Then
                        pFt2.Value(pFL.FeatureClass.Fields.FieldCount - 1) = 1
                        pFt2.Store
                    End If
                End If
            End If
            Set pFt2 = pFtCol.NextFeature
        Loop
        Set pFt = pftCur.NextFeature
    Loop

msgbox "Done"
End Sub

0 голосов
ответил 05 Ноя, 06 от Grigoriy (127,020 баллов)

' Удаляет записи с одинаковой геометрией в выделенном слое
' Работает только с шейп-файлами. Рекомендую сделать копию шейп-файла.

Public Sub RemoveDup()
    Dim mx As IMxDocument
    Dim pFL As IFeatureLayer
    'Dim sfield As String
    Dim shpfld As String
    Dim shpfldind As Integer
    Dim oidfldind As Integer
   
    Set mx = ThisDocument
    Set pFL = mx.SelectedLayer
    shpfld = pFL.FeatureClass.ShapeFieldName
    shpfldind = pFL.FeatureClass.Fields.FindField(pFL.FeatureClass.ShapeFieldName)
    oidfldind = pFL.FeatureClass.Fields.FindField(pFL.FeatureClass.OIDFieldName)
   
    If pFL Is Nothing Then Exit Sub
   
    Dim pFt As IFeature
    Dim pftCur As IFeatureCursor
    Dim pFt2 As IFeature
    Dim pFtCol As IFeatureCursor
    Dim pSQ As ISpatialFilter
    Dim pRelOp As IRelationalOperator
    Dim pGeom As IGeometry
    Dim n, n1 As Integer
   
    Set pftCur = pFL.Search(Nothing, False)
    Set pFt = pftCur.NextFeature
    Do Until pFt Is Nothing
        Set pSQ = New SpatialFilter
        pSQ.GeometryField = shpfld
        Set pGeom = pFt.ShapeCopy
        Set pSQ.Geometry = pGeom
        sfield = pFt.Fields.Field(pFt.Fields.FieldCount - 1).Name
        'pSQ.SpatialRel = esriSpatialRelContains
        pSQ.SpatialRel = esriSpatialRelIntersects
        Set pFtCol = pFL.Search(pSQ, False)
        Set pFt2 = pFtCol.NextFeature
        'Set pFt2 = pFtCol.NextFeature
        Do Until pFt2 Is Nothing
            Set pRelOp = pFt2.Shape
            n = pFt2.Value(oidfldind)
            n1 = pFt.Value(oidfldind)
            If pFt2.Value(oidfldind) <> pFt.Value(oidfldind) Then
                If pRelOp.Equals(pGeom) Then
                   pFt2.Delete
                End If
            End If
            Set pFt2 = pFtCol.NextFeature
        Loop
        Set pFt = pftCur.NextFeature
    Loop

msgbox "Done"
End Sub

Добро пожаловать на сайт Вопросов и Ответов, где вы можете задавать вопросы по GIS тематике и получать ответы от других членов сообщества.
...