StackOverflow2013

Note that there are some explanatory texts on larger screens.

plurals

POhow to approach converting VBscript to Python code?
text
Body
copied!<p>I've been asked by my boss to convert a piece of vb script, which is manually run every Friday into python, except he wants it automated. I'm new to programming and would like some help deciding how to begin with this problem. This will be my first real programming project and fortunatley there is no real time restriction.</p> <p>Context: We have an ESRI Flexviewer for displaying maps in our organisation. The script in question takes polylines, calculates the angle of the line, then calculates the flow direction. It does this by using a to and from field within the polylines feature class and places direction arrows on the mid point of each pipe.</p> <p>I've pasted the script below... its kind of long but any help would be much appreciated!</p> <p>So what I'm asking for is a suggestion on how to attack this. Just a start. Do i list out the main processes the VB script is using? Do i draw a flow diagram and being writing out psydo code for python? should i identify the main processes, for example the loops? and use that as a framework to begin?</p> <pre><code>Imports System.Runtime.InteropServices Imports System.Drawing Imports ESRI.ArcGIS.ADF.BaseClasses Imports ESRI.ArcGIS.ADF.CATIDs Imports ESRI.ArcGIS.Display Imports ESRI.ArcGIS.Framework Imports ESRI.ArcGIS.Catalog Imports ESRI.ArcGIS.CatalogUI Imports ESRI.ArcGIS.Carto Imports ESRI.ArcGIS.Geometry Imports ESRI.ArcGIS.Geodatabase Imports ESRI.ArcGIS.esriSystem Imports ESRI.ArcGIS.SystemUI Imports System.Windows <ComClass(CmdFlowCreation.ClassId, CmdFlowCreation.InterfaceId, CmdFlowCreation.EventsId), _ ProgId("FlowArrows.CmdFlowCreation")> _ Public NotInheritable Class CmdFlowCreation Inherits BaseCommand #Region "COM GUIDs" ' These GUIDs provide the COM identity for this class ' and its COM interfaces. If you change them, existing ' clients will no longer be able to access the class. Public Const ClassId As String = "35ac8cdc-4893-42d5-97ad-f41804dcb618" Public Const InterfaceId As String = "ec8ac176-19cc-4979-a5ca-4f7cf80bb37b" Public Const EventsId As String = "af685c91-ec0a-4ccd-ad21-56f9811c5f72" #End Region #Region "COM Registration Function(s)" <ComRegisterFunction(), ComVisibleAttribute(False)> _ Public Shared Sub RegisterFunction(ByVal registerType As Type) ' Required for ArcGIS Component Category Registrar support ArcGISCategoryRegistration(registerType) 'Add any COM registration code after the ArcGISCategoryRegistration() call End Sub <ComUnregisterFunction(), ComVisibleAttribute(False)> _ Public Shared Sub UnregisterFunction(ByVal registerType As Type) ' Required for ArcGIS Component Category Registrar support ArcGISCategoryUnregistration(registerType) 'Add any COM unregistration code after the ArcGISCategoryUnregistration() call End Sub #Region "ArcGIS Component Category Registrar generated code" Private Shared Sub ArcGISCategoryRegistration(ByVal registerType As Type) Dim regKey As String = String.Format("HKEY_CLASSES_ROOT\CLSID\{{{0}}}", registerType.GUID) GxCommands.Register(regKey) End Sub Private Shared Sub ArcGISCategoryUnregistration(ByVal registerType As Type) Dim regKey As String = String.Format("HKEY_CLASSES_ROOT\CLSID\{{{0}}}", registerType.GUID) GxCommands.Unregister(regKey) End Sub #End Region #End Region Private Const dDistance As Double = 0.5 Private Const bAsRatio As Boolean = True Private m_application As IApplication Dim pFClass As IFeatureClass Public m_pPropertySet As ESRI.ArcGIS.esriSystem.IPropertySet 'SDE Connection Properties Public m_pWS As IWorkspace Public m_pWSF As IWorkspaceFactory Public bContinue As Boolean Public pLineLayer As IFeatureLayer Public pPointLayer As IFeatureLayer Public bCreate As Boolean Public bUpdate As Boolean ' A creatable COM class must have a Public Sub New() ' with no parameters, otherwise, the class will not be ' registered in the COM registry and cannot be created ' via CreateObject. Public Sub New() MyBase.New() ' TODO: Define values for the public properties MyBase.m_category = "PNCC ARCCatalog" 'localizable text MyBase.m_caption = "Flow Creation" 'localizable text MyBase.m_message = "Create flow arrows. 9.3" 'localizable text MyBase.m_toolTip = "Flow Creation 9.3 (17-May-2010)" 'localizable text MyBase.m_name = "FlowArrows.CmdFlowCreation" 'unique id, non-localizable (e.g. "MyCategory_ArcCatalogCommand") Try 'TODO: change bitmap name if necessary Dim bitmapResourceName As String = Me.GetType().Name + ".bmp" ' MyBase.m_bitmap = New Bitmap(Me.GetType(), bitmapResourceName) MyBase.m_bitmap = Global.FlowArrows.My.Resources.BMPCmdFlowCreation Catch ex As Exception System.Diagnostics.Trace.WriteLine(ex.Message, "Invalid Bitmap") End Try End Sub '' Public ReadOnly Property Enabled() As Boolean Implements ESRI.ArcGIS.SystemUI.ICommand.Enabled '' Dim mxDoc As IMxDocument '' Dim layerCount As Integer '' 'pApp is set in OnCreate '' mxDoc = CType(m_pApp.Document, IMxDocument) '' layerCount = mxDoc.FocusMap.LayerCount '' If pLayerCount> 0 Then '' Return True '' Else '' Return False '' End If '' End Property 'Private Property Get ICommand_Enabled() As Boolean 'ICommand_Enabled = True 'Dim pGxApplication As IGxApplication 'Dim pGxObject As IGxObject 'Dim pGxDataSet As IGxDataset 'Set pGxApplication = mApplication 'Set pGxObject = pGxApplication.SelectedObject '' 'If TypeOf pGxObject Is IGxDataset Then ' Set pGxDataSet = pGxObject ' If TypeOf pGxDataSet.Dataset Is IFeatureClass Then '' Dim pFClass As IFeatureClass ' Set pFClass = pGxDataSet.Dataset ' If pFClass.ShapeType = esriGeometryPolyline Then ' ICommand_Enabled = True ' End If ' End If 'Else ' ICommand_Enabled = False 'End If 'End Property Public Overrides Sub OnCreate(ByVal hook As Object) If Not hook Is Nothing Then m_application = CType(hook, IApplication) 'Disable if it is not ArcCatalog If TypeOf hook Is IGxApplication Then MyBase.m_enabled = True Else MyBase.m_enabled = False End If End If ' TODO: Add other initialization code End Sub Public Overrides Sub OnClick() 'TODO: Add CmdFlowCreation.OnClick implementation Dim pLayer As ILayer Dim pFeatLayer As IFeatureLayer Dim pFeatClass As IFeatureClass pLineLayer = New FeatureLayer pFeatClass = GetArcCatalogSelectedLayer() If pFeatClass Is Nothing Then Exit Sub End If pLineLayer.FeatureClass = pFeatClass ''''MyBase.m_enabled = False GetWSFactory() PopulateLineAngle() End Sub Public Function GetArcCatalogSelectedLayer() As IFeatureClass Dim arcCatalog As IGxApplication arcCatalog = CType(m_application, IGxApplication) 'Get the Selected Object in Catalog Dim catalogSelectedObject As ESRI.ArcGIS.Catalog.IGxObject = arcCatalog.SelectedObject If (Not (TypeOf catalogSelectedObject Is ESRI.ArcGIS.Catalog.IGxDataset)) Then System.Windows.Forms.MessageBox.Show("Must have feature dataset selected") Return Nothing End If 'Make sure it's a Feature Class Dim catalogDataset As IGxDataset catalogDataset = CType(catalogSelectedObject, IGxDataset) If (catalogDataset.Type <> esriDatasetType.esriDTFeatureClass) Then System.Windows.Forms.MessageBox.Show("Must have feature featureclass selected") Return Nothing End If Dim featureClass As IFeatureClass featureClass = CType(catalogDataset.Dataset, IFeatureClass) If featureClass.ShapeType <> esriGeometryType.esriGeometryPolyline Then System.Windows.Forms.MessageBox.Show("Must have a LINE type featureclass selected") Return Nothing End If Return featureClass End Function Public Sub GetWSFactory() On Error Resume Next Dim pDataset As IDataset Dim pWorkSpace As IWorkspace pDataset = pLineLayer.FeatureClass pWorkSpace = pDataset.Workspace m_pPropertySet = pWorkSpace.ConnectionProperties If Not m_pPropertySet Is Nothing Then m_pWSF = New ESRI.ArcGIS.DataSourcesGDB.SdeWorkspaceFactory m_pWS = m_pWSF.Open(m_pPropertySet, 0) End If End Sub Private Sub PopulateLineAngle() 'get the center point of the line segment and populate the angle if the line Dim str As String = "" Try Dim pQueryFilt As IQueryFilter Dim pFeature As IFeature Dim pFeatCur As IFeatureCursor Dim pLnFeatClass As IFeatureClass Dim pPtFeatClass As IFeatureClass Dim pStatusBar As ESRI.ArcGIS.esriSystem.IStatusBar Dim Pi As Double Dim pCurve As ICurve Dim pMiddlePoint As IPoint Dim dAngle As Double Dim pLine As ILine Dim pTable As ITable Dim dLength As Double Dim lLnCompKeyFld As Long Dim lLnCompTypeFld As Long Dim lCompKeyFld As Long Dim lAngleFld As Long Dim lCompTypeFld As Long Dim pNewFeat As IFeature Dim pDS As IDataset Dim lastOID As Integer = 0 pStatusBar = m_application.StatusBar Pi = 4 * System.Math.Atan(1) '-------- 1. Get the point layer --------------- pPointLayer = GetPointLayer() lastOID = GetLastOID(pPointLayer.FeatureClass) If pPointLayer Is Nothing Then ' MsgBox "The Update point layer does not exist!", vbCritical, "Process Halted" Exit Sub End If '-------- 2. populate update fields index ---------- pPtFeatClass = pPointLayer.FeatureClass lCompKeyFld = pPtFeatClass.FindField("CompKey") lAngleFld = pPtFeatClass.FindField("Angle") lCompTypeFld = pPtFeatClass.FindField("CompType") pLnFeatClass = pLineLayer.FeatureClass lLnCompKeyFld = pLnFeatClass.FindField("Compkey") lLnCompTypeFld = pLnFeatClass.FindField("CompType") '--------- 3. populate the angle for all the features in the line layer ---- ''''pQueryFilt = New QueryFilter ''''pFeatCur = pLnFeatClass.Search(pQueryFilt, False) pQueryFilt = New QueryFilter '''''' pTable = CType(pLnFeatClass, ITable) Dim tableSort As ITableSort = New TableSortClass() tableSort.Table = pTable tableSort.QueryFilter = pQueryFilt tableSort.Fields = "OBJECTID" pLnFeatClass = CType(pTable, IFeatureClass) pFeatCur = pLnFeatClass.Search(pQueryFilt, False) '''''' pFeature = pFeatCur.NextFeature Dim iCnt As Integer = 0 Dim pWorkspaceEdit As ITransactions pWorkspaceEdit = m_pWS pWorkspaceEdit.StartTransaction() Do While Not pFeature Is Nothing And iCnt < lastOID 'Loop through existing features. iCnt += 1 pStatusBar.Message(0) = "Finding .... feature:" & pFeature.OID & " - " & iCnt.ToString pFeature = pFeatCur.NextFeature System.Windows.Forms.Application.DoEvents() Loop Do While Not pFeature Is Nothing iCnt += 1 pStatusBar.Message(0) = "Calculating .... feature:" & pFeature.OID & " - " & iCnt.ToString pCurve = pFeature.Shape dLength = pCurve.Length pMiddlePoint = New ESRI.ArcGIS.Geometry.Point 'get the middle point pCurve.QueryPoint(esriSegmentExtension.esriNoExtension, dDistance, bAsRatio, pMiddlePoint) 'get the angle pLine = New ESRI.ArcGIS.Geometry.Line pCurve.QueryTangent(esriSegmentExtension.esriNoExtension, dDistance, bAsRatio, dLength, pLine) dAngle = pLine.Angle * 360 / (2 * Pi) dAngle = 270 + dAngle ' If dAngle < 90 Then ' dAngle = 90 - dAngle ' Else ' dAngle = 450 - dAngle ' End If 'add to point layer pNewFeat = pPtFeatClass.CreateFeature pNewFeat.Shape = pMiddlePoint If lAngleFld <> -1 Then pNewFeat.Value(lAngleFld) = CLng(dAngle) If lCompKeyFld <> -1 And lLnCompKeyFld <> -1 Then pNewFeat.Value(lCompKeyFld) = pFeature.Value(lLnCompKeyFld) End If If lCompTypeFld <> -1 And lLnCompTypeFld <> -1 Then pNewFeat.Value(lCompTypeFld) = pFeature.Value(lLnCompTypeFld) End If pNewFeat.Store() pWorkspaceEdit.CommitTransaction() pFeature = pFeatCur.NextFeature If iCnt Mod 100 = 0 Then System.Windows.Forms.Application.DoEvents() End If Loop pStatusBar.Message(0) = "Finished!" Catch ex As Exception MsgBox(ex.Message + " - " + str) m_application.StatusBar.Message(0) = "Finished with errors!" End Try End Sub Private Function GetLastOID(ByVal pFClass As IFeatureClass) As Integer 'sde workspace open start a transaction to rollback if any error occurs On Error Resume Next Dim pWorkspaceEdit As ITransactions pWorkspaceEdit = m_pWS '' pWorkspaceEdit.StartTransaction() ' 'delete feature class records ' Dim pFeatCursor As IFeatureCursor Dim pFeature As IFeature pFeatCursor = pFClass.Update(Nothing, False) pFeature = pFeatCursor.NextFeature Dim OID As Integer = 0 ' Do While pFeature Is Nothing = False OID = pFeature.OID pFeature = pFeatCursor.NextFeature Loop If OID > 0 Then '' Delete the last one, it might have been corrupted Dim qFilter As IQueryFilter qFilter = New QueryFilter qFilter.WhereClause = "OBJECTID = " & OID.ToString pFeatCursor = pFClass.Update(qFilter, False) pFeature = pFeatCursor.NextFeature pFeatCursor.DeleteFeature() OID = OID - 1 End If Return OID End Function Private Function GetPointLayer() As ILayer On Error GoTo eh Dim pFWS As IFeatureWorkspace pFWS = m_pWS Dim sNewFCName As String Dim sFCName As String sFCName = GetFeatureClassName(pLineLayer) sNewFCName = sFCName & "_FLOW_UPDATE" ' ' Get the feature class Dim pFeatureClass As IFeatureClass pFeatureClass = pFWS.OpenFeatureClass(sNewFCName) If pFeatureClass Is Nothing Then 'not exits MsgBox("The feature class : " & sNewFCName & " does not exist, please create it first then run the tool again.") GoTo eh Else ''AK dont delete features. Will find the last and continue from there. ''''DeleteFeatures(pFeatureClass) 'already exists, delete all the features ' Dim pDS As IDataset ' Set pDS = pFeatureClass ' pDS.Delete ' ' Set pFeatureClass = CreateFeatureClass(sNewFCName) End If Dim pFeatureLayer As IFeatureLayer pFeatureLayer = New FeatureLayer pFeatureLayer.FeatureClass = pFeatureClass GetPointLayer = pFeatureLayer Exit Function eh: GetPointLayer = Nothing End Function Public Function GetFeatureClassName(ByVal pFeatLayer As IFeatureLayer) As String Dim pDataset As IDataset pDataset = pFeatLayer.FeatureClass GetFeatureClassName = pDataset.Name End Function Private Sub DeleteFeatures(ByVal pFClass As IFeatureClass) 'sde workspace open start a transaction to rollback if any error occurs On Error Resume Next Dim pWorkspaceEdit As ITransactions pWorkspaceEdit = m_pWS pWorkspaceEdit.StartTransaction() ' 'delete feature class records ' ' Dim pFeatCursor As IFeatureCursor ' Dim pFeature As IFeature ' Set pFeatCursor = pFClass.Update(Nothing, False) ' Set pFeature = pFeatCursor.NextFeature ' ' Do While pFeature Is Nothing = False ' pFeatCursor.DeleteFeature ' Set pFeature = pFeatCursor.NextFeature ' Loop Dim pFeatureWorkspace As IFeatureWorkspace pFeatureWorkspace = pWorkspaceEdit Dim t As ITable t = pFeatureWorkspace.OpenTable(pFClass.AliasName) t.DeleteSearchedRows(Nothing) pWorkspaceEdit.CommitTransaction() End Sub End Class </code></pre>

Querying!

Guidance

An individual column

Larger individual text columns get their own page to allow for proper reading.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload