Expedition PCB Replace Cell Form

Version 2

    Combobox 2개와 Button 하나로 구성된 Form의 Script 입니다.

    Test 했을 때 동작은 하지만 동작 속도가 조금 느린것 같습니다.

    속도를 개선 할 수 있는 방법이 있을까요?

     

    Dim pcbApp : Set pcbApp = Application
    Dim pcbDoc : Set pcbDoc = pcbApp.ActiveDocument
    Dim pcbCmd


    'License the document

    If (validateServer(pcbDoc) = 1) Then

    Set Comps = pcbDoc.Components(epcbSelectPlaced, epcbCompAll, epcbCelltypeAll)
      Comps.sort
      For Each Comp In Comps
          If Comp.RefDes = "" Then
          Else
        ComboBox1.Addstring(Comp.RefDes)
       End If
      Next
     

    Set pcbCmd = pcbApp.Gui.RegisterCommand("Untitled")
      Call Scripting.AttachEvents(pcbCmd, "cmd")

    Function cmd_OnMouseDown(button, flags, x, y)
         If button = epcbMouseButtonLeft Then
             pcbDoc.UnselectAll
         End If
    End Function

    Function cmd_OnMouseClk(button, flags, x, y)
       If button = epcbMouseButtonLeft Then


      Dim colParts
           Set colParts = pcbDoc.PickComponents(x, y, x, y, epcbCompAll, epcbCelltypePackage)
          colParts.Selected = True

       Dim oPartSel,oPartRefDes

       If colParts.count = 0 Then
          MsgBox "No part is selected!"
        
       Elseif colParts.count = 1 Then
           Set oPartSel = colParts.Item(1)
              oPartRefDes = oPartSel.RefDes
     
           For i = 0 To ComboBox1.GetNumItems-1
               If ComboBox1.GetText(i) = oPartRefDes Then
               ComboBox1.Selection = i 
               End If
        Next
        Call UpdateCellList
       Else
          MsgBox "Select only one part!"
       End If
      End If
      End Function
    End If

    Sub UpdateCellList
    Dim pcbApp
    Set pcbApp = GetObject(, "MGCPCB.Application")
    Dim pcbDoc
    Set pcbDoc = pcbApp.ActiveDocument 
    If (validateServer(pcbDoc) = 1) Then
       selectedRefDes = ComboBox1.GetText(ComboBox1.selection)
       pcbDoc.UnSelectAll

       ComboBox2.ResetContent()
         
          Set pdbEditor = pcbDoc.PartEditor
          Scripting.AddTypeLibrary ("MGCPCBLibraries.PartsEditorDlg")

          Set pdbDB = pdbEditor.ActiveDatabase
          pdbEditor.Visible = False
         
          Set Comps = pcbDoc.Components(epcbSelectPlaced, epcbCompAll, epcbCelltypeAll, selectedRefDes)
          For Each Comp In Comps
              Comp.selected = True
              pcbDoc.ActiveView.SetExtentsToSelection
            
           Set ptis = pdbDB.Partitions
           For Each pti In ptis
               Set pts = pti.Parts(epdbPartAll, Comp.PartName)
               For Each pt In pts
                   Set cls = pt.CellReferences(epdbCellRefAll)
                   For Each cl In cls
                       If cl.Name = "" Then
           Else
               ComboBox2.Addstring(cl.Name)
                       End If
                   Next
               Next
           Next
       Next

          Set pdbDB = Nothing
          pdbEditor.Quit
    End If    
    End Sub


    '---------------------------------------

    ' Begin Validate Server Function - Checks For valid license

    '---------------------------------------

    Private Function ValidateServer(doc)
       
        Dim key, licenseServer, licenseToken

        ' Ask Expedition뭩 document for the key
        key = doc.Validate(0)

        ' Get license server
        Set licenseServer = CreateObject("MGCPCBAutomationLicensing.Application")

        ' Ask the license server for the license token
        licenseToken = licenseServer.GetToken(key)

        ' Release license server
        Set licenseServer = nothing

        ' Turn off error messages.  Validate may fail if the token is incorrect
        On Error Resume Next
        Err.Clear

        ' Ask the document to validate the license token
        doc.Validate(licenseToken)
        If Err Then
            ValidateServer = 0   
        Else
            ValidateServer = 1
        End If

       End Function

    '---------------------------------------

    ' End Validate Server Function
    '-------------------------------------
    'End of (Declarations)

    'End of (Declarations)

    Sub Apply_EventClick()
    Dim This : Set This = Apply
    Dim pcbApp
    Set pcbApp = GetObject(, "MGCPCB.Application")
    Dim pcbDoc
    Set pcbDoc = pcbApp.ActiveDocument

    If (validateServer(pcbDoc) = 1) Then
      pcbDoc.UnSelectAll
      selectedRefDes = ComboBox1.GetText(ComboBox1.selection)
         Set Comps = pcbDoc.Components(epcbSelectPlaced, epcbCompAll, epcbCelltypeAll, selectedRefDes)
      If Comps.count = 1 Then
          For Each Comp In Comps
              Comp.selected = True
              pcbDoc.ActiveView.SetExtentsToSelection

           ' get InputValue 
        selectedCell = ComboBox2.GetText(ComboBox2.selection)

        If selectedCell = "" Then
       
        Else
       
               Comp.ReplaceCell(selectedCell)
            Comp.selected = False
            MsgBox(selectedRefDes & " has been replaced to " & selectedCell & ".")
           
        End If
       Next
      End If
    End If
    End Sub

    Sub ComboBox1_EventChange()
    Dim This : Set This = ComboBox1
    Call UpdateCellList
    End Sub

    Sub TheView_EventInitialize()
    Dim This : Set This = TheView
    TheFrame.Height = 210
    TheFrame.Width = 430
    End Sub