PADS logic脚本导出BOM Excel

' PADS Logic BOM Output
' By lyp (337252561@qq.com)
Dim fn As String

Sub Main
    fn = ActiveDocument
    If fn = "" Then
        fn = "Untitled"
    End If

    tempFile = DefaultFilePath & "\temp.txt"
    Open tempFile For Output As #1
    item = 0
    StatusBarText = "Generating report..."
    Print #1, "ITEM";vbTab;"Part Type"; vbTab;"P/N_1"; vbTab;"Manufacturer_1_P/N"; vbTab;"Description"; vbTab;"Manufacturer_1"; vbTab; "Value"; vbTab; "QTY"; vbTab; "REF-DES"
    For Each pkg in ActiveDocument.PartTypes
        'Print #1, pkg.Name; vbTab; note
        qty = 0
        value = ""
        description = ""
        manufacturer = ""
        pn = ""
        manufacturerpn = ""
        symbol = ""
        item = item + 1
        'Print #1, item; vbTab;
        For Each part In pkg.Components
            value = AttrValue(part, "Value")
            description = AttrValue(part, "Description")
            manufacturer = AttrValue(part, "Manufacturer_1")
            pn = AttrValue(part, "P/N_1")
            value = AttrValue(part, "Value")    
            manufacturerpn = AttrValue(part, "Manufacturer_1_P/N")
            sysid = AttrValue(part, "SYSID")
            qty = qty+1
            symbol = symbol + part.Name + ", "
        Next        
        symbol_len = Len(symbol)
        symbol = Mid(symbol,1, symbol_len - 2)
        Print #1, item; vbTab; part.PartType ; vbTab; pn ; vbTab;manufacturerpn; vbTab;description; vbTab;manufacturer; vbTab;value; vbTab; qty; vbTab; symbol;
        Print #1
    Next pkg
    StatusBarText = ""
    Close #1
    ExportToExcel
End Sub

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:I1").Font.Bold = True
    xl.Range("A1:I1").NumberFormat = "@"
    xl.Range("A1:I1").AutoFilter
    xl.ActiveSheet.UsedRange.Columns.AutoFit
    'Output Report Header
    xl.Rows(1).Insert
    xl.Rows(1).Cells(1) = Space(1) & "Part Report "& " WWZL-BOM " & " 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 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
Function AttrValue (comp As Object, atrName As String) As String
    If comp.Attributes(atrName) Is Nothing Then
        AttrValue = ""
    Else
        AttrValue = comp.Attributes(atrName).Value
    End If
End Function

脚本保存为：PADS_Logic_BOM_to_Excel.bas
加载脚本步骤：

Bom输出结果，有乱码是ASCII不包含特殊符号，安装open office解决：

PS:
1、文件->报告->材料清单->设置，可以导出BOM
新建excel，pads全选复制到excel

导出后用Beyond Compare 比较内容