之前设计的PADS导出BOM脚本是没有区别顶层和底层元器件的。如下所示。
现在有一个要求,就是让导出的BOM帮我们分开顶层和底层的元器件,并整理统计好显示出来。实现这个功能,可以在原来的脚本上做一些修改,就可以导出区分顶层和底层元器件的BOM。具体方法如下。
如上图所示,代码里增加了元器件层信息的读取和整理元器件的时候层信息的判断,最后就可以实现了元器件分顶层和底层的归类统计。
参考代码如下:
Const Columns = Array("Item","Description","Value","PCB Decal","Ref","OPTION","Quantity","layer") of column alignment: 0 - Align Left, 1 - Align Right, 2 - Align Center. Const Align = Array( 0, 0, 0, 0, 0, 0, 0) Dim fname As String Sub Main fname = ActiveDocument If fname = "" Then fname = "Untitled" End If tempFile = DefaultFilePath & "\temp.txt" Open tempFile For Output As #1 StatusBarText = "Generating report..." table header For i = 0 To UBound(Columns) OutCell Columns(i) Next Print #1 Dim part_Count As Integer part_Count = 0 For Each part In ActiveDocument.Components If part.Pins.Count > 1 Then part_Count = part_Count + 1 End If Next part ReDim Parts(part_Count, 14) As String For Each part In ActiveDocument.Components If part.Pins.Count > 1 Then For intJ = 1 To 8 "" = AttrVal(part, "Description") = AttrVal(part, "Value") = part.Decal = part.Name = AttrVal(part, "Option") = "" = ActiveDocument.LayerName(part.layer) = Next intJ intI = intI + 1 End If Next part Dim comp_counter As Integer Dim Species As Integer Const flag As Integer = 10 Dim Component As String Dim Component_temp As String Dim label As String comp_counter = 0 Species = 0 For i = 1 To UBound(Parts, 1) If Parts(i, flag) = "" Then Component = Parts(i, 2) &Parts(i, 6) label = Parts(i, 5) comp_counter = 1 For j = i + 1 To UBound(Parts, 1) Component_temp =Parts(j, 2) &Parts(j, 6) If Component = Component_temp Then comp_counter = comp_counter + 1 label = label & ", " & Parts(j, 5) flag) = "0" End If Next j 5) = label 7) = Str(comp_counter) Species = Species + 1 End If Next i Dim NO_ As Integer ReDim SpeciesArray1(Species, 8) ReDim SpeciesArray2(Species, 8) NO_ = 1 For i = 1 To UBound(Parts, 1) If Parts(i, flag) = "" And Parts(i, 8)="TOP" Then 1) = Parts(i, 1) 2) = Parts(i, 2) 3) = Parts(i, 3) 4) = Parts(i, 4) 5) = Parts(i, 5) 6) = Parts(i, 6) 7) = Parts(i, 7) 8) = Parts(i, 8) NO_ = NO_ + 1 ElseIf Parts(i, flag) = "" And Parts(i, 8)="BOT" Then 1) = Parts(i, 1) 2) = Parts(i, 2) 3) = Parts(i, 3) 4) = Parts(i, 4) 5) = Parts(i, 5) 6) = Parts(i, 6) 7) = Parts(i, 7) 8) = Parts(i, 8) NO_ = NO_ + 1 End If Next i OutCell "TOP" Print #1 For i = 1 To UBound(SpeciesArray1, 1) If SpeciesArray1(i, 8)="TOP" Then For j =1 To 8 OutCell SpeciesArray1(i,j) Next j Print #1 End If Next i OutCell "BOT" Print #1 For i = 1 To UBound(SpeciesArray2, 1) If SpeciesArray2(i, 8)="BOT" Then For j =1 To 8 OutCell SpeciesArray2(i,j) Next j Print #1 End If Next i Close #1 ExportToExcel End Sub Function AttrVal (obj As Object, nm As String) AttrVal = IIf(obj.Attributes(nm) Is Nothing, "", obj.Attributes(nm)) End Function Sub ExportToExcel FillClipboard Dim xl As Object On Error Resume Next Set xl = GetObject(,"Excel.Application") On Error GoTo ExcelError ' Enable error trapping. If xl Is Nothing Then Set xl = CreateObject("Excel.Application") End If True = xl.Workbooks.Add xl.ActiveSheet.Paste H1").Font.Bold = True : H1").NumberFormat = "@" : H1").AutoFilter : For i = 0 To UBound(Align) + 1).HorizontalAlignment = Choose(Align(i)+1, -4131, -4152, -4108) Next xl.ActiveSheet.UsedRange.Columns.AutoFit Report Header xl.Rows(1).Insert Space(1) & "Part Report for " & fname & " on " & Now = xl.Rows(2).Insert True = Design Totals lastRow = xl.ActiveSheet.UsedRange.Rows.Count + 1 + 1).Font.bold = True + 1).Cells(1) = Space(1) & "Design Part count: " & ActiveDocument.Components.Count xl.Range("A1").Select On Error GoTo 0 ' Disable error trapping. Exit Sub ExcelError: MsgBox Err.Description, vbExclamation, "Error Running Excel" On Error GoTo 0 ' Disable error trapping. Exit Sub End Sub Sub OutCell (txt As String) Print #1, txt; vbTab; End Sub Sub FillClipboard StatusBarText = "Export Data To Clipboard..." Load whole file to string variable tempFile = DefaultFilePath & "\temp.txt" Open tempFile For Input As #1 L = LOF(1) Input$(L,1) = Close #1 whole data to clipboard Clipboard AllData$ Kill tempFile StatusBarText = "" End Sub