2013-12-16 175 views
4

我的老闆已經要求我將一段vb腳本轉換爲一段vb腳本,每週五手動運行到python中,除了他希望自動化。我是編程新手,想要幫助決定如何開始解決這個問題。這將是我第一個真正的編程項目,fortunatley沒有實時限制。如何將VBscript轉換爲Python代碼?

上下文:我們有一個ESRI Flexviewer用於在我們的組織中顯示地圖。有問題的腳本需要多段線,計算線的角度,然後計算流向。它通過使用多段線要素類中的to和from域來完成此操作,並在每個管道的中點放置方向箭頭。

我已經粘貼了下面的腳本......它的種類很長,但任何幫助將不勝感激!

所以我要求的是如何攻擊這個建議。只是一個開始。我列出了VB腳本使用的主要過程嗎?我是否繪製流程圖並正在編寫python的psydo代碼?我應該確定主要流程,例如循環?並將其用作開始的框架?

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,不能像這樣運行。 –

回答

5

繪製代碼的流程圖;然後將其轉換爲僞代碼。定義要保存數據的主要變量(「容器」)。它們的關係是什麼?其中一些變化而其他變化是否持續?有數據的數組嗎?

預先考慮這些事情會真正幫助您編寫乾淨的代碼。你會開始你的編程旅程在正確的方向。大多數人只會開始編寫代碼。

我建議你抽空問這個問題。祝你好運。