I have a VBA button that allows me to click on my layer and generate a point by a MouseDown event. It populates a certain filed with the distance between the first temp point and the second temp point divided by 5.28 + InputBox. The point is also created from the second temp point. Since VBA will no longer be supported i thought i would look into python. I know you can capture coordinates with the onMouseDownMap function. maybe use point = arcpy.Point and ptGeometry = arcpy.PointGeometry(point) to get the distance between the two points,then cursor = arcpy.UpdateCursor to update the field, then feature store?
any ideas, thoughts? i would gratefully appreciate it.
Here is my vba code
any ideas, thoughts? i would gratefully appreciate it.
Here is my vba code
Code:
Dim pFeature1 As IFeature
Dim tmpPoint1 As IPoint
Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
'Adds a point to a shapefile
Dim pMap As IMap
Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
Set pMap = pMxDoc.FocusMap
Dim pDataset As IDataset
Dim pFeature1 As IFeature
'Dim tmpPoint1 As IPoint
'Get the first layer in the map
Dim pFeatLyr As IGeoFeatureLayer
Set pFeatLyr = pMap.Layer(0)
'Create a point from the mouse down click
Dim tmpPoint As IPoint
Set tmpPoint = New Point
Set tmpPoint = pMxDoc.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
'Get the feature class
Dim pFClass As IFeatureClass
Set pFClass = pFeatLyr.FeatureClass
'QI from IFeatureclass to IDataset
'Dim pDataset As IDataset
Set pDataset = pFClass
'Get the Workspace from the IDataset
Dim pWorkspace As IWorkspace
Set pWorkspace = pDataset.Workspace
'QI from IWorkspace to IWorkspaceEdit
Dim pWorkspaceEdit As IWorkspaceEdit
Set pWorkspaceEdit = pWorkspace
'Start editing if needed
If Not pWorkspaceEdit.IsBeingEdited Then
pWorkspaceEdit.StartEditing (True)
End If
'Start an edit operation
pWorkspaceEdit.StartEditOperation
'Create the new point feature
Dim pFeature As IFeature
Dim dblDist As Double
If button = 2 Then
Set pFeature1 = Nothing
Set tmpPoint1 = Nothing
Exit Sub
End If
If pFeature1 Is Nothing Then
If tmpPoint1 Is Nothing Then
Set tmpPoint1 = tmpPoint
Else
Set pFeature = pFClass.CreateFeature
Set pFeature.Shape = tmpPoint
If Not tmpPoint1 Is Nothing Then
dblDist = 0
dblDist = GetDistance1(pFeature)
pFeature.Value(pFeature.Class.Fields.FindField("Distance_")) = dblDist
pFeature.Value(pFeature.Class.Fields.FindField("SiteNum")) = (dblDist / 5.28) + InputBox("Enter Address Range") & ""
pFeature.Store
End If
Set pFeature1 = pFeature
End If
Else
Set pFeature = pFClass.CreateFeature
Set pFeature.Shape = tmpPoint
If Not pFeature1 Is Nothing Then
dblDist = 0
dblDist = GetDistance(pFeature1, pFeature)
pFeature.Value(pFeature.Class.Fields.FindField("Distance_")) = dblDist
pFeature.Value(pFeature.Class.Fields.FindField("SiteNum")) = (dblDist / 5.28) + InputBox("Enter Address Range") & ""
pFeature.Store
End If
Set pFeature1 = pFeature
End If
'Complete the edit operation
'pWorkspaceEdit.StopEditOperation
pMxDoc.ActiveView.Refresh
pMxDoc.UpdateContents
End Sub
Function GetDistance1(pFeature1 As IFeature) As Double
Dim pGeom1 As IGeometry
Dim pGeom2 As IGeometry
Dim pProx As IProximityOperator
Dim dblDist As Double
Set pGeom1 = tmpPoint1
Set pGeom2 = pFeature1.Shape
Set pProx = pGeom2
dblDist = pProx.ReturnDistance(pGeom1)
'MsgBox dblDist
GetDistance1 = dblDist
End Function
Function GetDistance(pFeature1 As IFeature, pFeature2 As IFeature) As Double
Dim pGeom1 As IGeometry
Dim pGeom2 As IGeometry
Dim pProx As IProximityOperator
Dim dblDist As Double
Set pGeom1 = pFeature1.Shape
Set pGeom2 = pFeature2.Shape
Set pProx = pGeom2
dblDist = pProx.ReturnDistance(pGeom1)
'MsgBox dblDist
GetDistance = dblDist
End Function