如何将VBScript转换为Python代码?

4
我被老板要求将每个星期五手动运行的VB脚本转换为Python,但他希望自动化。我是编程新手,需要一些帮助来决定如何解决这个问题。这将是我的第一个真正的编程项目,幸运的是没有实时限制。
背景:我们在组织中使用ESRI Flexviewer显示地图。所讨论的脚本获取折线,计算线的角度,然后计算流向。它通过在折线要素类中使用“起始点”和“终止点”字段,在每个管道的中点放置方向箭头。
以下是脚本的内容...有点长,但任何帮助都将不胜感激!
因此,我想要的是攻击此问题的建议。只是一个开始。我是否应列出VB脚本正在使用的主要过程?我是否应绘制流程图并开始编写Python的伪代码?我是否应该识别主要过程,例如循环?并将其用作开始的框架?
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

1
您发布的代码不是VBScript,因此无法直接运行。 - Ansgar Wiechers
1个回答

5

绘制代码的流程图,然后将其翻译成伪代码。定义您想要存储数据的主要变量(“容器”)。它们之间的关系是什么?其中一些是否会发生变化,而其他一些是否保持不变?是否存在数据的数组?

提前考虑这些问题将真正有助于编写清晰明了的代码。这将使您在编程之旅中朝着正确的方向开始。大多数人只会开始编写代码。

我赞扬您花时间提出这个问题。祝你好运。


网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接