Partlist sheet:2 or 3 or 4 ...

[martinhoos]

Hello,

i copy and paste a code that exports the partlist from an IDW in a folder, Excel Format. The Problem is, if the partlist is placed on sheet:2 (blatt:2) or somewhere else.

Please can you Change the code, that it exports the partlist where ever the list is placed.

Thanks in advance!

Regards from germany

Martin

DocType = ThisDoc.Document.DocumentType
	If DocType <> DocumentTypeEnum.kDrawingDocumentObject Then
	MessageBox.Show("Diese Funktion ist nur in einer Zeichnungsableitung zulässig. Abbruch! ", "nur in Zeichnung", MessageBoxButtons.OK, MessageBoxIcon.Error)
	Exit Sub
	End If

Dim oDrawDoc As DrawingDocument
oDrawDoc = ThisApplication.ActiveDocument
	If oDrawDoc.ActiveSheet.PartsLists.Count = 0 Then
	MessageBox.Show("Keine Stückliste vorhanden. Abbruch! ", "Keine Stückliste", MessageBoxButtons.OK, MessageBoxIcon.Error)
	Exit Sub
	ElseIf oDrawDoc.ActiveSheet.PartsLists.Count > 1 Then
	MessageBox.Show("Es sind mehrere Stücklisten vorhanden, die Erste im Browser wird für den Export verwendet", "mehrere Stückliste", MessageBoxButtons.OK, MessageBoxIcon.Information)
	End If

Dim oPartList As PartsList
oPartList = oDrawDoc.ActiveSheet.PartsLists.Item(1)
Dim oPartsList1 As PartsList
oPartsList1 = oDrawDoc.ActiveSheet.PartsLists.Item(1)
Dim sAuthor, sPath, sFilename, sTXTFileName As String
Dim oPropSet As PropertySet

sPath = "x:\input\"

Dim oRefedDoc As Document
oRefedDoc = oPartlist.ReferencedDocumentDescriptor.ReferencedDocument
sAuthor = oRefedDoc.propertySets(1) ("Author").Value
	If sAuthor = "" Then
	MessageBox.Show("Keine Artikelnummer in Datei  " & oRefedDoc.FullDocumentName & "  vergeben. Abbruch! ", "leeres iProp", MessageBoxButtons.OK, MessageBoxIcon.Error)
	Exit Sub
	End If

sFilename = sAuthor & ".txt"
sTXTFileName = sPath & sFilename

Dim oDoc As Inventor.DrawingDocument
oDoc = ThisDoc.Document
Dim oSheet As Inventor.Sheet
oSheet = oDoc.Sheets("Blatt:1") ' sheet by name
Dim oPartslist As PartsList

oPartslist = oSheet.PartsLists(1) 
oPartslist.Export(sTXTFilename,PartsListFileFormatEnum.kTextFileTabDelimited)  
MessageBox.Show("Die Exportdatei der Stückliste wurde im Verzeichnis X:\INPUT\ gespeichert", "Export TXT", MessageBoxButtons.OK, MessageBoxIcon.Information)

[bradeneuropeArthur]

for each sheet in odrawdoc.sheets
Dim oPartList As PartsList
oPartList = sheet.PartsLists.Item(1)
Dim oPartsList1 As PartsList
oPartsList1 = oDrawDoc.ActiveSheet.PartsLists.Item(1)
Dim sAuthor, sPath, sFilename, sTXTFileName As String
Dim oPropSet As PropertySet

sPath = "x:\input\"

Dim oRefedDoc As Document
oRefedDoc = oPartlist.ReferencedDocumentDescriptor.ReferencedDocument
sAuthor = oRefedDoc.propertySets(1) ("Author").Value
If sAuthor = "" Then
MessageBox.Show("Keine Artikelnummer in Datei " & oRefedDoc.FullDocumentName & " vergeben. Abbruch! ", "leeres iProp", MessageBoxButtons.OK, MessageBoxIcon.Error)
Exit Sub
End If

sFilename = sAuthor & ".txt"
sTXTFileName = sPath & sFilename

Dim oDoc As Inventor.DrawingDocument
oDoc = ThisDoc.Document
'Dim oSheet As Inventor.Sheet
'oSheet = oDoc.Sheets("Blatt:1") ' sheet by name
'Dim oPartslist As PartsList

'oPartslist = oSheet.PartsLists(1)
oPartslist.Export(sTXTFilename,PartsListFileFormatEnum.kTextFileTabDelimited)
next

[martinhoos]

Hello Brandeurope,

thanks for your reply. Your change is looking through all Sheets and stops with a message:

       bei iLogic.RuleEvalContainer.ExecRuleEval(String execRule)

I think the Problem is, if i have a partlist on sheet:1 and NO partlist on sheet:2.

It can happen that i have several sheets but only two of them have a partlist - the right one that i like to Export is the first one in the browser.

Thanks again for your help!

Regards Martin

[bradeneuropeArthur]

try this I am not at my desk but I put this together:

Public Sub pl()

Dim oDoc As Inventor.DrawingDocument
oDoc = ThisDoc.Document
Dim oSheet As Inventor.Sheet
edit       .............................'oSheet = oDoc.Sheets("Blatt:1") ' sheet by name edit
Dim oPartslist As PartsList

DocType = ThisDoc.Document.DocumentType
    If DocType <> DocumentTypeEnum.kDrawingDocumentObject Then
    
    Exit Sub
    End If

Dim oDrawDoc As DrawingDocument
oDrawDoc = ThisApplication.ActiveDocument

For Each oSheet In oDrawDoc.Sheets
oSheet.Activate
    If oDrawDoc.ActiveSheet.PartsLists.Count = 0 Then
    
    Exit Sub
    ElseIf oDrawDoc.ActiveSheet.PartsLists.Count > 1 Then
    
    End If
Next
Dim oPartList As PartsList
oPartList = oDrawDoc.ActiveSheet.PartsLists.Item(1)
Dim oPartsList1 As PartsList
oPartsList1 = oDrawDoc.ActiveSheet.PartsLists.Item(1)
Dim sAuthor, sPath, sFilename, sTXTFileName As String
Dim oPropSet As PropertySet

sPath = "x:\input\"

Dim oRefedDoc As Document
oRefedDoc = oPartList.ReferencedDocumentDescriptor.ReferencedDocument
sAuthor = oRefedDoc.PropertySets(1)("Author").Value
    If sAuthor = "" Then
    
    Exit Sub
    End If

sFilename = sAuthor & ".txt"
sTXTFileName = sPath & sFilename



oPartslist = oSheet.PartsLists(1)
oPartslist.Export(sTXTFileName, PartsListFileFormatEnum.kTextFileTabDelimited)

End Sub

[bradeneuropeArthur · Accepted solution]

edit:

Public Sub pl()

Dim oDoc As Inventor.DrawingDocument
Set oDoc = ThisApplication.ActiveDocument
Dim oSheet As Inventor.Sheet
'Set oSheet = oDoc.Sheets.Item(1) ' sheet by name
Dim oPartslist As PartsList

'DocType = ThisDoc.Document.DocumentType
    If oDoc.DocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then
    
    Exit Sub
    End If

Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument

For Each oSheet In oDrawDoc.Sheets
MsgBox oSheet.Name
oSheet.Activate
    If oDrawDoc.ActiveSheet.PartsLists.Count = 0 Then
    
    'Exit Sub
    ElseIf oDrawDoc.ActiveSheet.PartsLists.Count > 1 Then
    Dim oPartList As PartsList
oPartList = oDrawDoc.ActiveSheet.PartsLists.Item(1)
Dim oPartsList1 As PartsList
oPartsList1 = oDrawDoc.ActiveSheet.PartsLists.Item(1)
Dim sAuthor, sPath, sFilename, sTXTFileName As String
Dim oPropSet As PropertySet

sPath = "x:\input\"

Dim oRefedDoc As Document
oRefedDoc = oPartList.ReferencedDocumentDescriptor.ReferencedDocument
sAuthor = oRefedDoc.PropertySets(1)("Author").Value
    If sAuthor = "" Then

    Exit Sub
    End If

sFilename = sAuthor & ".txt"
sTXTFileName = sPath & sFilename



oPartslist = oSheet.PartsLists(1)
Call oPartslist.Export(sTXTFileName, PartsListFileFormatEnum.kTextFileTabDelimited)
    End If
Next


End Sub

[martinhoos]

Thanks again, thats it!

Regards Martin