---

Hallo Zusammen,
kurz zu mir, ich habe von VBA keinerlei Ahnung. Ich bin auf der Suche nach einer Möglichkeit, per Mausklick auf einen Button, die sich auf der geöffneten IDW befindliche Teileliste im TXT Format (durch Tab begrenzt) und unter dem Namen des iProperties "Eigenschaften-Modell <Autor>" in ein vorgegebenes Verzeichnis zu speichern?! Wie aufwendig wäre eine solche Routine?
Freu mich auf Antworten...
Sonnige Grüße aus Hessen
Martin

------------------
Wenn man einen Hund so dressiert hat, dass er über einen See fliegt, dann gibt es sicher ein paar Neider die das Tier für Wasserscheu halten...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo

Ja, das geht schon hart an die Grenzen des Möglichen. Kleiner Scherz 

Öffne mit Alt+F11 den VBA-Editor
Lege im Anwendungsprojekt ein neues Modul (mit sinnvollem) Namen an
Kopiere den Code da rein
Schließe den Editor
Rechte Maustaste auf die Ribbonleiste --> Benutzerbefehle anpassen
Such auf der linken Seite unter Makros dein (sinnvoll) benanntes Script
Füge es den Benutzerbefehlen hinzu
Dialog schließen
Ausprobieren

Code:

---

Public Sub Teilelistenexport()
Dim oApp As Inventor.Application
Set oApp = ThisApplication

If oApp.ActiveDocument.DocumentType <> kDrawingDocumentObject Then
MsgBox "Funktion ist nur in Zeichnungen zulässig"
Exit Sub
End If

Dim oDrawDoc As Inventor.DrawingDocument
Set oDrawDoc = oApp.ActiveDocument

Dim sAuthor, sPath, sFileName, sTXTFileName As String
Dim oPropSet As PropertySet
Dim iProp As Property

'Pfad anpassen
sPath = "C:\Temp\"

Set oPropSet = oDrawDoc.PropertySets.Item("{F29F85E0-4FF9-1068-AB91-08002B27B3D9}")

For Each iProp In oPropSet
    If iProp.Name = "Author" Then
        sAuthor = iProp.Value
    End If
Next

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

Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.FolderExists(sPath) Then MkDir sPath

If oDrawDoc.ActiveSheet.PartsLists.Count = 0 Then
    MsgBox "Keine Stückliste vorhanden!", vbCritical + vbOKOnly, "Stückliste fehlt"
    Exit Sub
ElseIf oDrawDoc.ActiveSheet.PartsLists.Count > 1 Then
    MsgBox "Es sind mehrere Stücklisten vorhanden!" & vbCrLf & "Es wird die erste Stückliste verwendet!", vbOKOnly + vbInformation, "Mehrere Stücklisten"
End If

Call oDrawDoc.ActiveSheet.PartsLists.Item(1).Export(sTXTFileName, kTextFileTabDelimited)

End Sub

---

------------------
MfG
Ralf

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Ralf, hier ein Vorschlag wie du den Code ein wenig optimieren kannst:

Zuvor:

Code:

---

Dim sAuthor
Dim oPropSet As PropertySet
Dim iProp As Property

Set oPropSet = oDrawDoc.PropertySets.Item("{F29F85E0-4FF9-1068-AB91-08002B27B3D9}")

For Each iProp In oPropSet
    If iProp.Name = "Author" Then
        sAuthor = iProp.Value
    End If
Next

---

Danach:

Code:

---

Dim sAuthor as String
sAuthor = oDrawing.PropertySets(1)("Author").Value

---

Vielleicht habe ich nur nicht den Sinn hinter der For Each erkannt? Die PropertySets 1-3 sind die Standardsets und sollten immer die Standardeigenschaften wie Autor beinhalten.

------------------
Grüße Igor

FX64 Software Solutions - Inventor Tools
FX64 LambdaSpect - Lichtsimulation mit Autodesk Inventor

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Igor

Der "Sinn" ist, das ich viel mit benutzerdefinierten iProps hantiert habe und sich dadurch diese Vorgehensweise eingeschliffen hat. Ich geb dir aber Recht, das es bei den Standard iProps überflüssig ist.

------------------
MfG
Ralf

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Ralf,
super Sache, es läuft "fast" wie gewollt. Ist es Möglich statt des Authors der IDW den Author des Modell zu bekommen?
Ich danke Dir!
Viele Grüße
Martin

------------------
Wenn man einen Hund so dressiert hat, dass er über einen See fliegt, dann gibt es sicher ein paar Neider die das Tier für Wasserscheu halten...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Moin

Ja geht. Ich habe die Reihenfolge im Code auch ein bißchen gedreht, um ein bißchen mögliche Fehler zu umgehen.

Code:

---

Sub Stückliste()
Dim oapp As Inventor.Application
Set oapp = ThisApplication

If oapp.ActiveDocument.DocumentType <> kDrawingDocumentObject Then
MsgBox "Funktion ist nur in Zeichnungen zulässig"
Exit Sub
End If

Dim oDrawDoc As Inventor.DrawingDocument
Set oDrawDoc = oapp.ActiveDocument

Dim sAuthor, sPath, sFileName, sTXTFileName As String
Dim oPropSet As PropertySet
Dim iProp As Property

'Pfad anpassen
sPath = "C:\Temp\"

If oDrawDoc.ActiveSheet.PartsLists.Count = 0 Then
    MsgBox "Keine Stückliste vorhanden!", vbCritical + vbOKOnly, "Stückliste fehlt"
    Exit Sub
ElseIf oDrawDoc.ActiveSheet.PartsLists.Count > 1 Then
    MsgBox "Es sind mehrere Stücklisten vorhanden!" & vbCrLf & "Es wird die erste Stückliste verwendet!", vbOKOnly + vbInformation, "Mehrere Stücklisten"
End If

Dim oPartslist As PartsList
Set oPartslist = oDrawDoc.ActiveSheet.PartsLists.Item(1)

Dim oRefedDoc As Document
Set oRefedDoc = oPartslist.ReferencedDocumentDescriptor.ReferencedDocument

sAuthor = oRefedDoc.PropertySets(1)("Author").Value

If sAuthor = "" Then
    MsgBox "iProp Author in Datei " & vbclf & oRefedDoc.FullDocumentName & vbCrLf & " ist leer. Abbruch", vbCritical, "leeres iProp"
    Exit Sub
End If

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

Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.FolderExists(sPath) Then MkDir sPath

Call oDrawDoc.ActiveSheet.PartsLists.Item(1).Export(sTXTFileName, kTextFileTabDelimited)

End Sub

---

------------------
MfG
Ralf

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Super Sache, es läuft !!!
Ralf ich danke Dir!
Viele Grüße aus Hessen...
Martin

------------------
Wenn man einen Hund so dressiert hat, dass er über einen See fliegt, dann gibt es sicher ein paar Neider die das Tier für Wasserscheu halten...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP