AnsweredAssumed Answered

Scripts 관련 초보 질문 입니다.

Question asked by ohjongkun on Jul 28, 2015
Latest reply on Aug 6, 2015 by ohjongkun

아래와 같이 heatsink 와 IC와의 동일 좌표를 출력하는 스크립니다.

동일 좌표의 heatsink와 보드에서 사용된 heatsink list를 출력하게 되어 있습니다.

질문 사항으로 현재는 동일한 개수 및 틀린 개수만 출력하는데 틀린개수의 수까지 포함 시키 싶습니다.

어떻게 하면 가능할지. 도움 요청 드립니다.

 

 

 

Dim pcbApp

Set pcbApp = GetObject(,"MGCPCB.ExpeditionPCBApplication")

Const spacebetween1 = 40   'distance between item and part number
Const spacebetween2 = 8    'between part number and quantity
Const spacebetween3 = 10   'between quantity and reference designator
Const sItemtitle = "ITEM_NUMBER"

Dim sMsg
Dim pcbDoc

Set pcbDoc = pcbApp.ActiveDocument

If (ValidateServer(pcbDoc) = 1) Then

    Dim Comps, i, tkyMsg()

    Dim fso

    Dim outFile

           Dim cellarray(), coordarray(), refdesarray()

           Dim j

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set outFile = fso.CreateTextFile(pcbDoc.Path & "LogFiles/Duplicated_cell.txt", True)

    set Comps = pcbDoc.Components(epcbSelectAll, epcbCompAll, epcbCelltypeAll)
   
          Comps.Sort()
          CreateDictTop

           'msgbox "Comps.count = " & Comps.count

           ReDim tkyMsg(Comps.count-1)

           ReDim cellarray(Comps.count-1)

           ReDim coordarray(Comps.count-1)

           ReDim refdesarray(Comps.count-1)
         

Function CreateDictTop
End Function

For i = 1 to Comps.count

        tkyMsg(i-1) = tkyMsg(i-1) & Comps.item(i).PositionX & Comps.item(i).PositionY & Comps.item(i).side & Comps.item(i).CellName & Comps.item(i).refdes

                     coordarray(i-1) = "X:" & Comps.item(i).PositionX & "    " & vbTab & "Y:" & Comps.item(i).PositionY &"       "& vbTab & "Side:" & Comps.item(i).side
                    
                     cellarray(i-1) = "CellName:" & Comps.item(i).CellName

                     refdesarray(i-1) = "RefDes:" & Comps.item(i).refdes

                     'outFile.WriteLine tkyMsg(i-1)

  Next
           Dim counter1
           outFile.WriteLine "Same Location Cells" & vbCrLf

           For i = 1 to Comps.count

                     For j = (i + 1) to Comps.count

                                If coordarray(i-1) = coordarray(j-1) and Comps.item(i).PositionX > 0 and Comps.item(i).PositionY > 0 and InStr(Cstr(refdesarray(j-1)),"U") > 0 Then

          outFile.WriteLine  & " : " & vbTab & coordarray(i-1)& "  " & vbTab & cellarray(i-1) & Space(spacebetween1 - Len(cellarray(i-1))) & (refdesarray(j-1))

                                          'outFile.WriteLine  & " : " & coordarray(j-1) & cellarray(j-1) & refdesarray(j-1)
                               counter1 = i + counter1  
                       
                      Else

                                End If

                     Next

           Next
'outFile.WriteLine counter1

        outFile.WriteLine vbCrLf & "Heatsink List"
        outFile.WriteLine  "---------------------------------------------------------------------------"
       
        Dim strCellName()
        Dim counter, coun
       
        ReDim strCellName(Comps.count-1)
       
        For i = 1 to Comps.count
                   
          strCellName(i-1) = Comps.item(i).CellName
         
          If InStr(Cstr(strCellName(i-1)),"eat") or InStr(Cstr(strCellName(i-1)),"EP62") or InStr(Cstr(strCellName(i-1)),"EJ62") > 0 then

            outFile.WriteLine(i) & " : " & vbTab & "X:" & Comps.item(i).PositionX & "    " & vbTab & "Y:" & Comps.item(i).PositionY & "    " & vbTab & Comps.item(i).CellName

            counter = i + counter

          End If

        Next

    If counter1 = counter Then outFile.WriteLine vbCrLf &  vbCrLf & "비교결과 : " & "Heatsink 개수와 동일한 좌표의 IC개수가 일치 합니다."
       If counter1 <> counter Then outFile.WriteLine  vbCrLf & "비교결과 : " & "Heatsink 개수와 동일한 좌표의 IC개수가 다릅니다."          

outFile.Close

MsgBox "Place File" & vbCrLf & pcbDoc.Path & "LogFiles/Duplicated_cell", vbOKOnly + vbInformation, "Complete"

Dim Win
Set Win = CreateObject("WScript.shell")
Win.Run "notepad.exe " & "LogFiles/Duplicated_cell.txt"

Else

    Msgbox("Could not validate the server. Exiting program.")

End If

Private Function ValidateServer(doc)

    Dim key, licenseServer, licenseToken

    key = doc.Validate(0)

    Set licenseServer = CreateObject("MGCPCBAutomationLicensing.Application")

    licenseToken = licenseServer.GetToken(key)

    Set licenseServer = nothing

    On Error Resume Next

    Err.Clear

 

    doc.Validate(licenseToken)

    If Err Then

        ValidateServer = 0  

    Else

        ValidateServer = 1

    End If

End Function

Outcomes