从工程图中导出明细表

'define the active document as an assembly file
Dim oAsmDoc As AssemblyDocument
oAsmDoc = ThisApplication.ActiveDocument
oAsmName = Left(oAsmDoc.DisplayName, Len(oAsmDoc.DisplayName) )
'check that the active document is an assembly file
If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
MessageBox.Show("Please run this rule from the assembly file.", "iLogic")
Exit Sub
End If
'get user input
RUsure = MessageBox.Show ( _
"This will create a .xls file for all of the asembly components that have drawings files." _
& vbLf & "This rule expects that the drawing file shares the same name and location as the component." _
& vbLf & " " _
& vbLf & "Are you sure you want to create PDF Drawings for all of the assembly components?" _
& vbLf & "This could take a while.", "iLogic  - Batch Output PDFs ",MessageBoxButtons.YesNo)
If RUsure = vbNo Then
Return
Else
End If
'- - - - - - - - - - - - -subass drawing - - - - - - - - - - - -
Dim oExcDocs As DocumentsEnumerator
oExcDocs = oAsmDoc.AllReferencedDocuments
Dim oExcDoc As Document
For Each oExcDoc In oExcDocs
idwPathName = Left(oExcDoc.FullDocumentName, Len(oExcDoc.FullDocumentName) -3) & "idw"
'check to see that the model has a drawing of the same path and name
If(System.IO.File.Exists(idwPathName)) Then
Dim oDrawDoc As DrawingDocument
oDrawDoc = ThisApplication.Documents.Open(idwPathName, True)
pathname = Left(oExcDoc.FullDocumentName, Len(oExcDoc.FullDocumentName) -3)
Dim oSheet1 As Inventor.Sheet
oSheet1 = oDrawDoc.Sheets("Ark:1")
Dim oPartslist1 As PartsList
oPartslist1 = oSheet1.PartsLists(1)
oPartslist1.Export(pathname & ".xls",PartsListFileFormatEnum.kMicrosoftExcel)
oDrawDoc.Close
Else
'If the model has no drawing of the same path and name - do nothing
End If
Next
'- - - - - - - - - - - - -Top Level Drawing - - - - - - - - - - - -
oAsmDrawing = ThisDoc.ChangeExtension(".idw")
oAsmDrawingDoc = ThisApplication.Documents.Open(oAsmDrawing, True)
oAsmDrawingName = Left(oAsmDrawingDoc.DisplayName, Len(oAsmDrawingDoc.DisplayName))
On Error Resume Next
path_and_name = ThisDoc.PathAndFileName(False)
Dim oSheet As Inventor.Sheet
oSheet = oAsmDrawingDoc.Sheets("Ark:1")
Dim oPartslist As PartsList
oPartslist = oSheet.PartsLists(1)
oPartslist.Export(path_and_name & ".xls",PartsListFileFormatEnum.kMicrosoftExcel)
oAsmDrawingDoc.Close
'- - - - - - - - - - - - -
MessageBox.Show("Done " & vbLf & oFolder, "iLogic")
'open the folder where the new ffiles are saved
Shell("explorer.exe " & oFolder,vbNormalFocus)