agray7501

VBA 2 Python Help needed..

Discussion created by agray7501 on Mar 23, 2011
Hi all,

Currently, I have a vba script referenced through a button uicontrol in arcmap that references a results window form pop-up. The results window form allows the user to select from a list of results, selects the users selection, then zooms to the extent of the feature all on a single click event.

I have had it working only on polygons and was recently trying to modify the code to reference points when I decided it would be better to migrate the code to python.. I would like to convert the vba code to arcpy for ARCGIS 10 even though we are still using v9.3.

I originally found the code on Arcscripts and just modified it to include my own data layers.

Here is the code for the button uicontrol..
Private Sub FindByAddress_Click()
    On Error GoTo eh

 Dim pMxDoc As IMxDocument
  Dim pMap As IMap
  Dim pActiveView As IActiveView
  Dim pFeatureLayer As IFeatureLayer
  Dim pFeatureSelection As IFeatureSelection
  Dim pQueryFilter As IQueryFilter
  
  Set pMxDoc = ThisDocument

  Set pMap = pMxDoc.FocusMap
  Set pActiveView = pMap

  
  'use EnumLayer to find a parcel layer
 'IEnumLayer
  Dim LayerFound As Boolean
  LayerFound = False
  
  'check to make sure the parcel layer is in TOC, if not, add it
  Dim x As Long
  Dim pMatchLayer As ILayer
        Dim LayerName1 As String
                
        LayerName1 = "PARCELS"
                
        Dim pDataset As IDataset
        Dim pFeatureLayer1 As IFeatureLayer
        
 For x = 0 To pMap.LayerCount - 1
    
        Set pMatchLayer = pMap.Layer(x)
          
        Set pFeatureLayer1 = pMatchLayer
        Set pDataset = pFeatureLayer1.FeatureClass
     If UCase(pDataset.Name) = UCase(LayerName1) Or UCase(pMatchLayer.Name) = UCase("PARCELS") Then
           LayerFound = True
         Exit For
      End If
    Next
   
   'Add a parcel layer here from SDE, if not connected to SDE, give option _
    to add from any other source
    
 If LayerFound = False Then
    MsgBox "No Parcel Layer Found in TOC, Parcels from SDE will be added to your ArcMap", vbInformation, "ADD Parcel Layer"
    Call AddDatafromSDE.AddSDELayer2ArcMap
    'se pMatchLayer as the newly added layer
    Set pMatchLayer = pMap.Layer(0)
  End If
  
  Set pFeatureLayer = pMatchLayer
    Set pFeatureSelection = pFeatureLayer
    Set pWorkFeatureLayer = pMatchLayer
    'MsgBox "You need to have a parcel layer by the name of Parcels " & Chr(13) & _
    "or any parcel layer, parcel view from SDE", vbCritical, "Add a Parcel Layer"
    'Exit Sub
   'End If
   
   'Check to see if the query field exists
   If pFeatureLayer.FeatureClass.FindField("ADDRESS") = -1 Then
    MsgBox "The Address field is not found!"
    Exit Sub
   End If
   
            'Create the query filter
        Set pQueryFilter = New QueryFilter
        Dim StrName As String
        
        Dim pChoice As Long
        
     'pChoice = MsgBox(StrName = InputBox("Please Enter An Owner's LAST NAME or Part of the Last Name. Type Lastname,then Comma, then space,then first name to find an owner quicker, as the one in input box:", _
         "Owner Query", "SMITH JOHN") = vbOKCancel)
         
          StrName = UCase$(InputBox("Please Enter An Address or Part of it:", "FIND ADDRESS", "", 0.6, 0.6))
         
        'pChoice = InputBox("Please Enter An Address or Part of it:", _
         "FIND ADDRESS", "")
        If StrName = "" Then
          MsgBox "Nothing Entered, or What You Entered Is Invalid", vbInformation, "Try Again"
            Exit Sub
         ' ElseIf pChoice = 2 Then
          '  Exit Sub
         End If
                                    
        pQueryFilter.WhereClause = "ADDRESS LIKE '%" & StrName & "%'"
  'MsgBox pQueryFilter.WhereClause
  
  
  'Invalidate only the selection cache
  'Flag the original selection
        pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
  'Perform the selection
       pFeatureSelection.SelectFeatures pQueryFilter, esriSelectionResultNew, False
  'Flag the new selection
  
    If pFeatureSelection.SelectionSet.Count < 1 Then
        MsgBox "No Match Found", vbInformation, "Please try another address"
        Exit Sub
    End If
        
        Dim pFeatureClass As IFeatureClass
        Set pFeatureClass = pFeatureLayer.FeatureClass
  
        '??????????????????????????
        'Dim pDataset As IDataset
        'Set pDataset = pFeatureClass
        'MsgBox pDataset.Name
        'MsgBox pDataset.Workspace.PathName
        
        'zoom to the selected feature
        Dim pFCursor As IFeatureCursor
        Set pFCursor = pFeatureClass.Search(pQueryFilter, True)
  
        Dim pFeature As IFeature
        Set pFeature = pFCursor.NextFeature
        
        'if only one match found, then zoom to it directly, otherwise, return
        'a list of matches
        
        If pFeatureSelection.SelectionSet.Count = 1 Then
            Dim pEnvelope As IEnvelope
            Set pEnvelope = pFeature.Extent
            pEnvelope.Expand 5#, 5#, True
            pActiveView.Extent = pEnvelope
            pActiveView.Refresh
         Exit Sub
        End If
        '???????????????????????????????????????
        'If there are more than one record found, need to add all of them to _
        a list box, but sort them before adding to a list
        Dim DiagCollection As New Collection
        Dim Inst
        Dim Item
  
        Do Until pFeature Is Nothing 'add owner to give user more clue which one to choose
        
    
            DiagCollection.Add pFeature.Value(pFeature.Fields.FindField("ADDRESS")) & _
            " / " & pFeature.Value(pFeature.Fields.FindField("MLNAM"))
            
        Set pFeature = pFCursor.NextFeature
        Loop
  
  Set DiagCollection = SortCollection(DiagCollection)
  
  For Each Item In DiagCollection
    frmFindAddress.lstAddress.AddItem Item
  Next

        '?????????????????????????????
        'add query result to listbox
      '  Do Until pFeature Is Nothing
      '  frmQueryResult.lstOwner.AddItem pFeature.Value(pFeature.Fields.FindField("OWNER"))
      '  Set pFeature = pFCursor.NextFeature
      '  Loop
        
        
        frmFindAddress.Caption = "Query Result for " & StrName
        
        frmFindAddress.Label1.Caption = pFeatureSelection.SelectionSet.Count & _
        " Matches Found for " & StrName & vbNewLine & "Please click one record to select and zoom to it"
        frmFindAddress.Show
   
 
Exit Sub
eh:
  MsgBox "Find ADDRESS Error- " & Err.Description
End Sub



Here is the form code for frmFindAddress...
Private Sub lstAddress_Click()
    On Error GoTo eh

 Dim pMxDoc As IMxDocument
  Dim pMap As IMap
  Dim pActiveView As IActiveView
  Dim pFeatureLayer As IFeatureLayer
  Dim pFeatureSelection As IFeatureSelection
  Dim pQueryFilter As IQueryFilter
  
  Set pMxDoc = ThisDocument

  Set pMap = pMxDoc.FocusMap
  pMap.ClearSelection
  Set pActiveView = pMap

    Set pFeatureSelection = pWorkFeatureLayer
    
     Dim pFeatureClass As IFeatureClass
    Set pFeatureClass = pWorkFeatureLayer.FeatureClass
    'MsgBox pFeatureClass.AliasName
    
    Set pQueryFilter = New QueryFilter
   
   Dim ListString As String
   ListString = frmFindAddress.lstAddress.Text
   
    pQueryFilter.WhereClause = "ADDRESS = '" & _
    Left(ListString, InStr(ListString, "/") - 1) & "'"
    
   ' pQueryFilter.WhereClause = "ADDRESS = '" & _
    frmFindAddress.lstAddress.Text & "'"
   ' MsgBox pQueryFilter.WhereClause
    
     pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
  'Perform the selection
        pFeatureSelection.SelectFeatures pQueryFilter, esriSelectionResultNew, False
  'Flag the new selection
    
    Dim pFCursor As IFeatureCursor
        Set pFCursor = pFeatureClass.Search(pQueryFilter, True)
        
        Dim pFeature As IFeature
        Set pFeature = pFCursor.NextFeature
        Dim pEnvelope As IEnvelope
        Set pEnvelope = pFeature.Extent
  
        pEnvelope.Expand 5#, 5#, True
        pActiveView.Extent = pEnvelope
        pActiveView.Refresh
     
 Exit Sub
eh:
  MsgBox "Find Address Error- " & Err.Description
        
End Sub


Any help you can provide in converting this set of code to python would be greatly appreciated..
Thanks in advance..

Outcomes