Distanzen

Hallo Uwe,

ich kanne AcGis nicht, falls es keine vorgegebene Funktion gibt, fallen mir zwei Wege ein:

1) über einen Dreisatz:
(x2 - x1)² + (y2 - y1)² = distanz²

2) über eine Linie
Linie aus Gebäudemittelpunkt und Hydrant machen und Länge zurückgeben lassen.

Wahrscheinlich gibt es aber doch die Möglichkeit das einfacher zu machen....

Jörg

Hallo Uwe,

ergänzend zu Wolfgangs Tipp: falls Du keine Lust auf eine .dll hast, folgendes VBA-Schnipsel macht so ungefähr das gleiche (ist natürlich etwas unausgereifter, dafür aber mit anpassungsfähigem QuellCode).
Du kannst in der Karte einfach Dein Polygon auswählen, links in der TOC Deinen Hydrantenlayer und dann die Berechnung über ein UI-Button-Control starten. Per Inputbox wirst Du dann noch nach Deiner MaximalDistanz zur Featureauswahl gefragt. (Damit entfällt zB auch die zusätzliche Auswahl der Feature bei der .dll)
Die Distanzen werden in ein Feld "Distance" vom Typ Double in die Hydrantentabelle eingetragen. Vor jeder Berechnung werden alle Werte auf null gesetzt, so daß in der Tabelle später nur die jeweils aktuellen Werte stehen (im Unterschied zur .dll). Alles weitere ist wie gesagt nach Lust und Laune anpassbar, etwa Layerauswahl per Formular o.ä.


Private Sub UIButtonControl_Click()
Dim pdoc As IMxDocument
Dim pMap As IMap
Dim pFLayer As IFeatureLayer
Dim pEnF As IEnumFeature
Dim pFea As IFeature
Dim varDistance As Variant

Set pdoc = ThisDocument
Set pMap = pdoc.FocusMap

'Es darf nur ein Feature selektiert sein
If pMap.SelectionCount > 1 Then
MsgBox "Mehr als ein Feature selektiert", vbcritical
Exit Sub
Else
Set pEnF = pMap.FeatureSelection
Set pFea = pEnF.Next
End If
'In der TOC muß der Ziellayer selektiert sein:
If pdoc.SelectedLayer Is Nothing Then
MsgBox "Es ist kein Ziellayer in der ausgewählt", vbcritical
Exit Sub
Else
Set pFLayer = pdoc.SelectedLayer
End If

varDistance = nZ(InputBox("Bitte geben Sie eine maximale Distanz ein, " & _
"für die die Berechnung durchgeführt werden soll"), "Fehler")
If Not varDistance = "Fehler" And IsNumeric(varDistance) Then
UpdateField pFea, pFLayer, CDbl(varDistance) 'Feature,Ziellayer, maximale Distance

'Ansicht aktualisieren
pdoc.ActiveView.Refresh
msgbox "fertig", vbinformation

Else
MsgBox "Fehler bei der Eingabe der Distanz", vbcritical
Exit Sub
End If
End Sub


Und in einem allgemeinen Modul:

Public Function UpdateField(Feature As IFeature, pFLayer As IFeatureLayer, Distance As Double)
Dim pFeatClass As IFeatureClass
Dim pFeat As IFeature
Dim pFeatCur As IFeatureCursor
Dim pFields As IFields

'1. Erstmal alle Tabelleneinträge auf null setzen
Set pFeatClass = pFLayer.FeatureClass
Set pFeatCur = pFeatClass.Search(Nothing, False)
Set pFields = pFeatCur.Fields
Set pFeat = pFeatCur.NextFeature
'wenn das Feld "Distance" nicht existiert, Feld anlegen
If pFields.FindField("Distance") = -1 Then
Dim pFieldedit As IFieldEdit
Dim pField As IField
Set pField = New Field
Set pFieldedit = pField
With pFieldedit
.Name = "Distance"
.Type = esriFieldTypeDouble
End With
pFeatClass.AddField pField
'Aktualisieren
Set pFeatCur = Nothing
Set pFields = Nothing
Set pFeat = Nothing
Set pFeatCur = pFeatClass.Search(Nothing, False)
Set pFields = pFeatCur.Fields
Set pFeat = pFeatCur.NextFeature
End If

Do While Not pFeat Is Nothing
pFeat.Value(pFields.FindField("Distance")) = 0 '(Feld Distance muß Double sein)
pFeat.Store 'Cur.UpdateFeature pFeat
Set pFeat = pFeatCur.NextFeature
Loop

'2. Dann (a) alle Punkte innerhalb der angegebenen Entfernung
'ermitteln (SpatialFilter), (b) Distanzen für alle
'selektierten Punkte in die Tabelle schreiben
'und (c) alle Punkte für die Bildschirmansicht selektieren

Dim pSpatialFilter As ISpatialFilter
Dim pTopoOp As ITopologicalOperator
Dim ptopoPoly As IPolygon 'Puffer
Dim pSelSet As ISelectionSet
Dim pFSel As IFeatureSelection
Dim pProxy As IProximityOperator

Set pFSel = pFLayer
Set pSelSet = pFSel.SelectionSet
Set pTopoOp = Feature.Shape
Set ptopoPoly = pTopoOp.Buffer(Distance) 'map units

'Filter erstellen
Set pSpatialFilter = New SpatialFilter
With pSpatialFilter
.GeometryField = "Shape"
.SpatialRel = esriSpatialRelIntersects
Set .Geometry = ptopoPoly
End With

'Filter anwenden
Set pFeatCur = pFLayer.FeatureClass.Search(pSpatialFilter, False)
Set pFeat = pFeatCur.NextFeature
Set pProxy = Feature.Shape

'Gefilterte Features selektieren und Distanz berechnen
Do While Not pFeat Is Nothing
pSelSet.Add pFeat.OID
pFeat.Value(pFields.FindField("Distance")) = pProxy.ReturnDistance(pFeat.Shape)
pFeat.Store
Set pFeat = pFeatCur.NextFeature
Loop

End Function


Falls das für Deine Berechnungen von Bedeutung ist:
Wenn ich das richtig verstanden habe mißt der (gebräuchliche) IProximityOperator im Gegensatz zu den Esri-Meßtools einfach die kürzeste Distanz zwischen Geometrien unabhängig vom Koordinatensystem. D.h. beide Layer müssen wohl das selbe (projizierte) Koordinatensystem verwenden (für die dll dürfte gleiches gelten).


Viele Grüße
Jörg Ostendorp