10 Replies Latest reply on Sep 13, 2018 12:29 PM by wheelspcb

    TestPoint script not working after Microsoft Office upgrade

    wheelspcb

      Can any of the scripting experts tell me why the attached script stopped working with Excel 2016? Worked ok with Excel2007.

        • 1. Re: TestPiont script not working after Microsoft Office upgrade
          mjc

          All my Basic scripts now longer work with Win 10 and VX2.3 and Vx2.2  Seems to be related to moving to Win10 as Win 7 VX2.2 was fine

          • 2. Re: TestPiont script not working after Microsoft Office upgrade
            wcowles2

            I'm blocked from looking at your program but have a guess. When I upgraded from office 2010 to 2016 all programs that worked Excel broke. Found that Excel library had changed rev and reference did not update. Check this by going to basic program dialog with program loaded. Right click the number tab down the left of the dialog box. Click edit references in popup dialog. You should show a PADS library and probably an Excel library with a not found error. Some of my programs write a comma separated file and open in Excel, these still work. Programs that read or write to cells within Excel do not. We are currently using PADS VX.2.1 and this list can not be altered after fresh install. At install PADS mad a list of available librarys on system with no edit feature. Tech support has put in a SR to add this. If anyone knows a work around I'm interested. Already tried reloading PADS.

            • 3. Re: TestPiont script not working after Microsoft Office upgrade
              wheelspcb

              Wcowles2,  Here is the txt

               

               

              '#Reference {00020813-0000-0000-C000-000000000046}#1.2#0#D:\Program Files\Microsoft Office\Office\EXCEL8.OLB#Microsoft Excel 8.0 Object Library

               

              ' List the spacing from any one testpoint to the nearest testpoint

               

              '

               

                

               

              Option Explicit

               

              Dim WithEvents xl As Excel.Application

               

              Dim procSel As Boolean

               

              Dim Testpoints (3000,5)

               

                

               

              Sub Main

               

                 Dim Title

               

                 Dim ans

               

                

               

                  'Set the Units to Mils

               

                  ActiveDocument.unit = ppcbUnitMils

               

              On Error Resume Next

               

              Set xl =  GetObject(,"Excel.Application")

               

              On Error GoTo 0

               

              If xl Is Nothing Then

               

              Set xl =  New Excel.Application

               

              FillCells

               

              Else

               

              If xl.Range("A1") = Title And xl.Range("B3") = ActiveDocument.Name Then

               

              ans = MsgBox ("Connect to existing Net List?", vbYesNoCancel)

               

              If ans  = vbNo Then

               

              FillCells

               

              ElseIf ans = vbCancel Then

               

              Exit Sub

               

              End If

               

              Else

               

              FillCells

               

              End If

               

              End If

               

                 xl.Visible= True

               

                  procSel = True

               

                

               

               

               

              End Sub

               

                

               

              Sub FillCells

               

                  Dim i

               

                  Dim TPCounter

               

                  Dim netcounter

               

                  Dim j

               

                  Dim b

               

                  Dim num

               

                  Dim apin

               

                  Dim apart

               

                  Dim counter

               

                  Dim newpercent

               

                  Dim oldpercent

               

                  Dim MyText

               

                  Dim avia

               

                  Dim K

               

                  Dim LeastDistance

               

                  Dim y

               

                  Dim Xdistance

               

                  Dim Ydistance

               

                  Dim Distance

               

                  Dim r

               

                  Dim temp0

               

                  Dim temp1

               

                  Dim temp2

               

                  Dim temp3

               

                  Dim temp4

               

                  Dim counter100

               

                  Dim counter075

               

                  Dim counter050

               

                  Dim counter00

               

                  Dim u

               

                  Dim s

               

                  Dim nCurrent

               

                  Dim nTotal

               

                  Dim cell

               

                

               

                

               

              nCurrent = 0

               

              nTotal = ActiveDocument.Components.Count + ActiveDocument.Nets.Count

               

              xl.Workbooks.Add

               

              xl.Visible= True

               

              xl.ActiveWorkbook.Styles("Normal").NumberFormat = "@"

               

              Set cell = xl.Range("A1")

               

              xl.Columns(1).ColumnWidth = 15

               

              xl.Columns(2).ColumnWidth = 20

               

              xl.Columns(3).ColumnWidth = 12

               

              xl.Columns(4).ColumnWidth = 12

               

              xl.Columns(5).ColumnWidth = 12

               

               

               

                  cell.Item(1,1) = "List of all testpoints with distance to nearest testpoint"

               

                  i = 1

               

                  xl.Rows(i & ":" & i).Font.Bold = True

               

                  i=3

               

                  cell.Item(i,1) = "Pin Name"

               

                  cell.Item(i,2) = "Net Name"

               

                  cell.Item(i,3) = "X"

               

                  cell.Item(i,4) = "Y"

               

                  cell.Item(i,5) = "Distance to nearest TP"

               

                  xl.Rows(i & ":" &  i).Font.Bold = True

               

                  i = 4

               

                  xl.ActiveCell.Offset (3,0).Activate

               

                  TPcounter = 0

               

                  netcounter = 0

               

                  j = 1

               

                  b = 0

               

                  '~~~~~~~~~~~~~~~~~~~~~~~~~~

               

                  ' List all testpoints that are pins

               

                  '~~~~~~~~~~~~~~~~~~~~~~~~~~

               

                  num = ActiveDocument.Pins.Count + ActiveDocument.Vias.Count

               

                  For Each aPin In ActiveDocument.Pins

               

                    If aPin.TestPoint <> ppcbTestPointNone Then

               

                    Testpoints (b,0) = aPin.Name

               

                     On Error GoTo MyErr

               

                      TestPoints (b,1) = aPin.Net

               

                    TestPoints (b,2) = aPin.PositionX

               

                  TestPoints (b,3) = aPin.PositionY

               

                  TestPoints (b,4) = 100000

               

                  TPcounter = TPcounter + 1

               

                  b = b + 1

               

                    End If

               

                      counter = counter + 1

               

                      Newpercent = Int((counter/num)*100)

               

                      If Newpercent <> oldpercent Then

               

                     MyText = "Finding Testpoints..." & Int((counter/num)*100) & "%"

               

                cell.Item(i+1,j) = MyText

               

                oldpercent = Int((counter/num)*100)

               

                End If

               

                  Next

               

                  '~~~~~~~~~~~~~~~~~~~~~~~~~~~

               

                  ' List all testpoints that are vias

               

                  '~~~~~~~~~~~~~~~~~~~~~~~~~~~

               

                  For Each aVia In ActiveDocument.Vias

               

                    If aVia.TestPoint <> ppcbTestPointNone Then

               

                    Testpoints (b,0) = aVia.type

               

                      TestPoints (b,1) = aVia.Net

               

                    TestPoints (b,2) = aVia.PositionX

               

                  TestPoints (b,3) = aVia.PositionY

               

                  TestPoints (b,4) = 100000

               

                      TPcounter = TPcounter + 1

               

                      b = b + 1

               

                    End If

               

                      counter = counter + 1

               

                      Newpercent = Int((counter/num)*100)

               

                      If Newpercent <> oldpercent Then

               

                     MyText = "Finding Testpoints..." & Int((counter/num)*100) & "%"

               

                cell.Item(i+1,j) = MyText

               

                oldpercent = Int((counter/num)*100)

               

                     End If

               

                  Next

               

                 

               

                 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

               

                 ' Compute nearest TP for each TP

               

                 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

               

                  num = TPCounter - 1

               

                  counter = 0

               

                  For k = 0 To TPCounter - 1

               

                    LeastDistance = 100000

               

                    For y = 0 To TPCounter - 1

               

                       If k <> y Then

               

                        Xdistance = Abs(Testpoints(k,2) - Testpoints(y,2))

               

                        Ydistance = Abs(Testpoints(k,3) - Testpoints(y,3))

               

                        Distance =  Sqr ((Xdistance*Xdistance) + (Ydistance*Ydistance))

               

                       If Distance < LeastDistance Then

               

                         LeastDistance = Distance

               

                      End If  

               

                       End If

               

                     Next 

               

                     Testpoints(k,4) = LeastDistance

               

                       counter = counter + 1

               

                       If num > 0 Then

               

                         Newpercent = Int((counter/num)*100)

               

                       Else

               

                         Newpercent = 100

               

                       End If 

               

                      

               

                       If Newpercent <> oldpercent Then

               

                       MyText = "Calculating Distances for " &  TPcounter & " Testpoints..." & Int((counter/num)*100) & "%"

               

                  cell.Item(i+1,j) = MyText

               

                  oldpercent = Int((counter/num)*100)

               

                End If

               

                  Next 

               

                  '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

               

                  ' Sort by Distance to nearest TP (bubble sort)

               

                  '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

               

                  cell.Item(i+1,j) = ""

               

                  num = TPCounter - 1

               

                  counter = 0

               

                  For r = 0 To TPCounter - 1

               

                    For k = 0 To TPCounter - 1

               

                      If Testpoints (r,4) < Testpoints (k,4) Then

               

                         Temp0 = Testpoints (r,0)

               

                         Temp1 = Testpoints (r,1)

               

                         Temp2 = Testpoints (r,2)

               

                         Temp3 = Testpoints (r,3)

               

                         Temp4 = Testpoints (r,4)

               

                         Testpoints (r,0) = Testpoints (k,0)

               

                         Testpoints (r,1) = Testpoints (k,1)

               

                         Testpoints (r,2) = Testpoints (k,2)

               

                         Testpoints (r,3) = Testpoints (k,3)

               

                         Testpoints (r,4) = Testpoints (k,4)

               

                         Testpoints(k,0) = Temp0

               

                         Testpoints(k,1) = Temp1

               

                         Testpoints(k,2) = Temp2

               

                         Testpoints(k,3) = Temp3

               

                         Testpoints(k,4) = Temp4

               

                       End If

               

                     Next

               

                       counter = counter + 1

               

                       If num > 0 Then

               

                         Newpercent = Int((counter/num)*100)

               

                       Else

               

                         Newpercent = 100

               

                       End If 

               

                       If Newpercent <> oldpercent Then

               

                       MyText = "Sorting by Distance..." & Int((counter/num)*100) & "%"

               

                        cell.Item(i+1,j) = MyText

               

                    oldpercent = Int((counter/num)*100)

               

                End If

               

                   Next

               

               

               

                

               

                  '~~~~~~~~~~~~~~~~~~~~~~~~~

               

                  ' Write the array to Excel

               

                  '~~~~~~~~~~~~~~~~~~~~~~~~~

               

                  counter100 = 0

               

                  counter075 = 0

               

                  counter050 = 0

               

                  counter00 = 0

               

                   For u = 0 To TPCounter  - 1

               

                       i = i + 1

               

                       xl.ActiveCell.Offset (1,0).Activate

               

                  cell.Item(i,j) = Testpoints (u,0)

               

                  cell.Item(i,j+1) = Testpoints (u,1)

               

                  cell.Item(i,j+2) = Testpoints (u,2)

               

                  cell.Item(i,j+3) = Testpoints (u,3)

               

                  cell.Item(i,j+4) = Testpoints (u,4)

               

                     s = testpoints(u,4)

               

                     If (s >= 100) Then

               

                       counter100 = counter100 + 1

               

                     ElseIf ((s >= 75) And (s < 100)) Then

               

                       counter075 = counter075 + 1

               

                     ElseIf ((s >= 50) And (s < 75)) Then

               

                       counter050 = counter050 + 1

               

                     ElseIf (s < 50) Then

               

                       counter00 = counter00 + 1

               

                     End If 

               

                   Next 

               

                

               

                  i=i+2

               

                  j = 1

               

                  xl.ActiveCell.Offset (2,0).Activate

               

                  cell.Item(i,j) = "Total Testpoints = " & TPCounter

               

                  i = i + 2

               

                  xl.ActiveCell.Offset (2,0).Activate

               

                  cell.Item(i,j) = "Number of testpoints larger than .100 spacing: " & counter100

               

                   xl.ActiveCell.Offset (1,0).Activate

               

                  cell.Item(i+1,j) =  "Number of testpoints .100 to .075 spacing: " & counter075

               

                  xl.ActiveCell.Offset (1,0).Activate

               

                  cell.Item(i+2,j) =  "Number of testpoints .075 to .050 spacing: " & counter050

               

                  xl.ActiveCell.Offset (1,0).Activate

               

                  cell.Item(i+3,j) =  "Number of testpoints less than .050 spacing: " & counter00

               

                

               

              MyErr:

               

                  Resume Next   

               

                

               

                

               

              End Sub

               

              • 4. Re: TestPiont script not working after Microsoft Office upgrade
                wheelspcb

                Wcowles,

                 

                Looks like you are correct. This script writes to cell. The error where you indicated is a "Bad reference: Microsoft 8.0 Object Library"
                 

                • 5. Re: TestPiont script not working after Microsoft Office upgrade
                  wcowles2

                  Wheels,

                  Check for this file

                  D:\Program Files\Microsoft Office\Office\EXCEL8.OLB                             

                  #Microsoft Excel 8.0 Object Library

                  Where did you find that text? My programs don’t show that first line. Sounds like we could change library name in that line. I think it's EXCEL9.OLB we want, been a few months ago that I looked at it.

                  William

                  • 6. Re: TestPiont script not working after Microsoft Office upgrade
                    wheelspcb

                    Open the .bas with notepad. Tried the EXCEL9.OLB change. No luck so far.

                    • 7. Re: TestPiont script not working after Microsoft Office upgrade
                      wcowles2

                      I see that now. Thanks for the tip. Will see what I can get to work next time I'm in programs.

                      William

                      • 8. Re: TestPiont script not working after Microsoft Office upgrade
                        joachim.grimmeissen

                        I'm very interested in the "testpoint distance" script.

                        Did you get i t to run ?

                         

                        Joachim

                        • 10. Re: TestPiont script not working after Microsoft Office upgrade
                          wheelspcb

                          I fixed it. Updated file attached.