AnsweredAssumed Answered

Create points with Mouse click

Question asked by Tonyalmeida on Feb 5, 2013
Latest reply on Apr 26, 2013 by Tonyalmeida
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
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 

Outcomes