之前设计的PADS导出BOM脚本是没有区别顶层和底层元器件的。如下所示。

现在有一个要求，就是让导出的BOM帮我们分开顶层和底层的元器件，并整理统计好显示出来。实现这个功能，可以在原来的脚本上做一些修改，就可以导出区分顶层和底层元器件的BOM。具体方法如下。

如上图所示，代码里增加了元器件层信息的读取和整理元器件的时候层信息的判断，最后就可以实现了元器件分顶层和底层的归类统计。

参考代码如下:

Const Columns = Array("Item","Description","Value","PCB Decal","Ref","OPTION","Quantity","layer") 'Array 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..." 'Output 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 Parts(intI,1) = "" Parts(intI,2) = AttrVal(part, "Description") Parts(intI,3) = AttrVal(part, "Value") Parts(intI,4) = part.Decal  Parts(intI,5) = part.Name Parts(intI,6) = AttrVal(part, "Option") Parts(intI,7) = "" Parts(intI,8) =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)   Parts(j, flag) = "0"     End If   Next j    Parts(i, 5) = label  Parts(i, 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   SpeciesArray1(NO_, 1) = Parts(i, 1)   SpeciesArray1(NO_, 2) = Parts(i, 2)   SpeciesArray1(NO_, 3) = Parts(i, 3)   SpeciesArray1(NO_, 4) = Parts(i, 4)   SpeciesArray1(NO_, 5) = Parts(i, 5)   SpeciesArray1(NO_, 6) = Parts(i, 6)   SpeciesArray1(NO_, 7) = Parts(i, 7)  SpeciesArray1(NO_, 8) = Parts(i, 8)  NO_ = NO_ + 1   ElseIf Parts(i, flag) = "" And Parts(i, 8)="BOT" Then  SpeciesArray2(NO_, 1) = Parts(i, 1)   SpeciesArray2(NO_, 2) = Parts(i, 2)   SpeciesArray2(NO_, 3) = Parts(i, 3)   SpeciesArray2(NO_, 4) = Parts(i, 4)   SpeciesArray2(NO_, 5) = Parts(i, 5)   SpeciesArray2(NO_, 6) = Parts(i, 6)   SpeciesArray2(NO_, 7) = Parts(i, 7)  SpeciesArray2(NO_, 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 xl.Visible = True xl.Workbooks.Add xl.ActiveSheet.Paste xl.Range("A1:H1").Font.Bold = True xl.Range("A1:H1").NumberFormat = "@" xl.Range("A1:H1").AutoFilter For i = 0 To UBound(Align) xl.Columns(i + 1).HorizontalAlignment = Choose(Align(i)+1, -4131, -4152, -4108) Next xl.ActiveSheet.UsedRange.Columns.AutoFit 'Output Report Header xl.Rows(1).Insert xl.Rows(1).Cells(1) = Space(1) & "Part Report for " & fname & " on " & Now xl.Rows(2).Insert xl.Rows(1).Font.bold = True 'Output Design Totals lastRow = xl.ActiveSheet.UsedRange.Rows.Count + 1 xl.Rows(lastRow + 1).Font.bold = True xl.Rows(lastRow + 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) AllData$ = Input$(L,1) Close #1 'Copy whole data to clipboard Clipboard AllData$ Kill tempFile StatusBarText = "" End Sub