---

Liebe Inventor Gemeinde,

ich stehe grade vor folgendem Problem:

Ich muss in vielen Bauteilen/Baugruppen Iproperties ändern.
Normalerweise habe ich kleine Änderungen zum Beispiel Änderungen von einem Kürzel, die ich recht schnell ändern kann, indem ich in die Stückliste der obersten Baugruppe gehe und über ein einfaches suchen/ersetzten die Iproperties aller verbauten Teile ändern kann.

Nun ist die Aufgabe gerade komplexer:
Es sind sehr viele und auch komplexere Änderungen vorzunehmen, die darüber nicht mehr abzudecken sind.
Ich habe eine Excel-Tabelle in der in einer Spalte die alten Werte der Iproperty steht und in der zweiten Spalte die neuen.

Ich weiß nicht ob es dazu überhaupt ein Makro braucht (ich habe es mal in diesem Forum platziert)?

Vielleicht kennt ja auch noch jemand eine andere Lösung für dieses Problem.
Gut wäre wenn ich nicht jedes ipt/iam einzeln anpacken müsste, sondern auch wie oben beschrieben, die oberste Baugruppe auswählen kann und dann alle Bauteile/Baugruppen durchlaufen werden.

Grüße,
Brandy

PS: Anwendung für IV 2015

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

---

Das dürfte im Prinzip nicht das Problem sein.

Vorab aber noch

1. Sind die iProps in jedem Bauteil vorhanden und müssen ersetzt werden?
2. Hast du in deiner Excel-Liste auch die Namen, der iProps?

------------------
MFG

Chris

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

---

Hallo Chris,

1. ja die Iproperties sind in jedem Bauteil vorhanden und sogar noch in allen Untergordneten Baugruppen
2. Es handelt sich immer um die gleiche IProperty  - und zwar "Revisionsnummer" (unter der Registerkarte "Projekt) - die habe ich einfach genutzt um für mich abrufbare Daten dort zu hinterlegen

Grüße,
Brandy

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

---

Dann ist es wirklich kein Problem.
Kennst du dich mit VBA aus?

EDIT: Der Name der Baugruppe/ des Bauteils ist in der Liste auch hinterlegt? Oder wie ist denn die Liste generell aufgebaut?

------------------
MFG

Chris

[Diese Nachricht wurde von Chris 31 am 21. Apr. 2016 editiert.]

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

---

Leider nicht wirkllich, ich habe mir bisher immer Makros aus dem Forum gesucht und mimimal angepasst.
Ich habe einige Makros um idw Schriftfelder/Feldtexte auszufüllen und für einzelene geöffnete Dateein Iproperties zu ändern.

Wie ich über eine Baugruppe die untergeordnenten ipts/Iam aufrufe und dass auch noch mit einer Tabelle verknüpfe fehlt mir leider total der Ansatz :-(
Wäre über Ansätze oder Links auf denen auch ich als Anfänger aufbauen kann, dankbar.

Edit: Überlesen: Nein, der Name der ipts / iam ist nicht in der Liste

Die Liste wäre in etwa so

alter Wert Iprop    neuer Wert Iprop
    x                      y
    Abcd                  GHIJ
  alt                      neu
  ....                    .....

im Grunde gibt sie nur an welcher Wert gesucht, und durch welchen ersetzt werden soll.
Gesucht werden aber geschätzt 100 verschiedene Werte.

Grüße,
Brandy

[Diese Nachricht wurde von Brandy32 am 21. Apr. 2016 editiert.]

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

---

Hier wäre auf die Schnelle mal ein Ansatz.

Ich kann es dir noch umbauen, wenn du mir den Namen des Excelblattes, die Spaltenbezeichnung für alt und neu gibst.

Code:

---

Public Sub iPropertiesaendern()

Dim oAssDoc As AssemblyDocument
Set oAssDoc = ThisApplication.ActiveDocument

Dim Propset As propertyset
Dim iProp As Property

Set Propset = oAssDoc.PropertySets("Inventor Summary Information")
Set iProp = Propset.Item(9)

iProp.Expression = oWorkbook.ActiveSheet.Cells(1, 1).Value

Dim oOccurrence As ComponentOccurrence
Dim oPath As String
Dim exapp As Excel.Application
Dim oWorkbook As Excel.workbook
Set exapp = CreateObject("Excel.Application")
Set oWorkbook = exapp.Workbooks.Open("PFAD ZUR EXCELDATEI")
exapp.Visible = True

For Each oOccurrence In oAssDoc.ComponentDefinition.Occurrences
If oOccurrence.DefinitionDocumentType = kAssemblyDocumentObject Then
oPath = oOccurrence.ReferencedDocumentDescriptor.FullDocumentName
Call baugruppe(oPath, oWorkbook)
ElseIf oOccurrence.DefinitionDocumentType = kPartDocumentObject Then
Call bauteil(oPath, oWorkbook)
End If
Next
oAssDoc.Update2
oAssDoc.Save2
oAssDoc.Close

End Sub

Private Function baugruppe(ByVal oPath As String, ByVal oWorkbook As Excel.workbook)
Dim Propset As propertyset
Dim iProp As Property
Dim oAssDoc As AssemblyDocument
Set oAssDoc = ThisApplication.Documents.Open(oPath, False)

Set Propset = oAssDoc.PropertySets("Inventor Summary Information")
Set iProp = Propset.Item(9)

iProp.Expression = oWorkbook.ActiveSheet.Cells(1, 1).Value

Dim oOcc As ComponentOccurrence
For Each oOccurrence In oAssDoc.ComponentDefinition.Occurrences
If oOccurrence.DefinitionDocumentType = kAssemblyDocumentObject Then
oPath = oOccurrence.ReferencedDocumentDescriptor.FullDocumentName

Call baugruppe(oPath, oWorkbook)
ElseIf oOccurrence.DefinitionDocumentType = kPartDocumentObject Then
oPath = oOccurrence.ReferencedDocumentDescriptor.FullDocumentName
Call bauteil(oPath, oWorkbook)
End If
Next
oAssDoc.Update2
oAssDoc.Save2
oAssDoc.Close

End Function
Private Function bauteil(ByVal oPath As String, ByVal oWorkbook As Excel.workbook)
Dim oPartdoc As PartDocument
Set oPartdoc = ThisApplication.Documents.Open(oPath)

Dim Propset As propertyset
Dim iProp As Property
Set Propset = oPartdoc.PropertySets("Inventor Summary Information")
Set iProp = Propset.Item(9)

iProp.Expression = oWorkbook.ActiveSheet.Cells(1, 1).Value

oPartdoc.Update2
oPartdoc.Save2
oPartdoc.Close

End Function

---

------------------
MFG

Chris

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

---

Hallo Chris,

wow, schon mal vielen Dank für deine Mühe.

Ich würde in Spalte A (Zelle A1) mit den alten Bezeichnungen starten und in Spalte B (Zelle B1) mit den neuen.
Kann ich aber grundsätzlich auch anders festlegen.
Name Excelblatt: Nomenklatur

Werde mich am Wochenende mit deinem Code auseinandersetzen (Werd ein wenig brauchen, um das grob nachvollziehen zu können,  ist doch vieles neues für mich dabei    ) und mir mal eine kleine Hilfsbaugruppe zum testen bauen.

Grüße,
Brandy

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

---

Guten Morgen,

habe den Code mal nach deinen Infos angepasst.
Habe auch ein bisschen was kommentiert zum besseren Verständnis. 

Code:

---

Public Sub iPropertiesaendern()

Dim oAssDoc As AssemblyDocument
Set oAssDoc = ThisApplication.ActiveDocument
Dim exapp As Excel.Application
Dim oWorkbook As Excel.workbook
Set exapp = CreateObject("Excel.Application")
Set oWorkbook = exapp.Workbooks.Open("PFAD ZUR EXCELDATEI")                'Noch den Pfad zu deiner ExcelDatei einfügen
exapp.Visible = True                                                      'Diese Zeile löschen, wenn Excel unsichtbar bleiben soll
Dim Propset As propertyset
Dim iProp As Property

Set Propset = oAssDoc.PropertySets("Inventor Summary Information")
Set iProp = Propset.Item(9)

Dim i As Integer
i = 1
Do
If oWorkbook.ActiveSheet.Cells(i, 1).Value <> "" Then                                'Prüft auf leere Zelle
If iProp.Expression = oWorkbook.Sheets.Item("Nomenklatur").Cells(i, 1).Value Then    'Vergleicht iProp-Inhalt mit cells(Zeile, Spalte 1)
iProp.Expression = oWorkbook.ActiveSheet.Cells(i, 2).Value                          'Wenn passend ersetzen mit Wert aus cells(Zeile, Spalte 2)
Exit Do
Else: i = i + 1                                                                      'Sonst Zeile erhöhen
End If
Else: Exit Do
End If
Loop

Dim oOccurrence As ComponentOccurrence
Dim oPath As String

For Each oOccurrence In oAssDoc.ComponentDefinition.Occurrences
If oOccurrence.DefinitionDocumentType = kAssemblyDocumentObject Then
oPath = oOccurrence.ReferencedDocumentDescriptor.FullDocumentName
Call baugruppe(oPath, oWorkbook)
ElseIf oOccurrence.DefinitionDocumentType = kPartDocumentObject Then
Call bauteil(oPath, oWorkbook)
End If
Next
oAssDoc.Update2
oAssDoc.Save2
oAssDoc.Close
oWorkbook.Saved = True
oWorkbook.Close
exapp.Quit
End Sub

Private Function baugruppe(ByVal oPath As String, ByVal oWorkbook As Excel.workbook)
Dim Propset As propertyset
Dim iProp As Property
Dim oAssDoc As AssemblyDocument
Set oAssDoc = ThisApplication.Documents.Open(oPath, False)

Set Propset = oAssDoc.PropertySets("Inventor Summary Information")
Set iProp = Propset.Item(9)

Dim i As Integer
i = 1
Do
If oWorkbook.Sheets.Item("Nomenklatur").Cells(i, 1).Value <> "" Then
If iProp.Expression = oWorkbook.ActiveSheet.Cells(i, 1).Value Then
iProp.Expression = oWorkbook.ActiveSheet.Cells(i, 2).Value
Exit Do
Else: i = i + 1
End If
Else: Exit Do
End If
Loop

Dim oOcc As ComponentOccurrence
For Each oOccurrence In oAssDoc.ComponentDefinition.Occurrences
If oOccurrence.DefinitionDocumentType = kAssemblyDocumentObject Then
oPath = oOccurrence.ReferencedDocumentDescriptor.FullDocumentName

Call baugruppe(oPath, oWorkbook)
ElseIf oOccurrence.DefinitionDocumentType = kPartDocumentObject Then
oPath = oOccurrence.ReferencedDocumentDescriptor.FullDocumentName
Call bauteil(oPath, oWorkbook)
End If
Next
oAssDoc.Update2
oAssDoc.Save2
oAssDoc.Close

End Function
Private Function bauteil(ByVal oPath As String, ByVal oWorkbook As Excel.workbook)
Dim oPartdoc As PartDocument
Set oPartdoc = ThisApplication.Documents.Open(oPath)

Dim Propset As propertyset
Dim iProp As Property
Set Propset = oPartdoc.PropertySets("Inventor Summary Information")
Set iProp = Propset.Item(9)

Dim i As Integer
i = 1
Do
If oWorkbook.Sheets("Nomenklatur").Cells(i, 1).Value <> "" Then
If iProp.Expression = oWorkbook.ActiveSheet.Cells(i, 1).Value Then
iProp.Expression = oWorkbook.ActiveSheet.Cells(i, 2).Value
Exit Do
Else: i = i + 1
End If
Else: Exit Do
End If
Loop

oPartdoc.Update2
oPartdoc.Save2
oPartdoc.Close

End Function

---

------------------
MFG

Chris

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

---

Hallo Chris,

vielen Dank.

Schnelltest mit einer kleine Hilfsbaugruppe hat soweit funktioniert.
Nur bei den Bauteilen die direkt in der obersten, geöffneten Baugruppe verbaut sind, steigt es aus.

- Schnelles Workarround. Die Baugruppe mit den Einzelteilen einfach noch mal in eine neue, übergeordnete Baugruppe packen.

Zur Info für andere, die das Makro noch mal benutzen wollen:
Für die Revisionsummer in Propset.Item(9) Propset.Item("Revision Number") eingeben.
und wichtig die Excel Libraries unter Tools/References aufrufen.

Weitere Erprobung an meinen großen Modellen folgt :-)

Grüße,
Brandy

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

---

Ah, Sorry...

Es müsste Propset.ItemByPropId(9) heißen, dann braucht man den Namen nicht.

Warum er in der obersten Baugruppe bei Bauteilen aussteigt habe ich jetzt nicht erkennen können.
Gibt er denn eine Fehlermeldung?

------------------
MFG

Chris

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

---

Ok, wieder was gelernt.

Fehlermeldung ist Runtime error '13'
Type mismatch.

Hängt dann in der private function bauteil bei
Set oPartdoc

hier scheint er noch in der ersten Unterbaugruppe zu hängen, diese wird auch im inventor nicht geschlossen.
habe gerade noch mal eine weitere unterbaugruppe ergänzt, diese schein dann gar nicht mehr aufgerufen zu werden.

Auch hier funktioniert aber der Trick mit dem Platzieren in einer weiterne Oberbaugruppe.

Grüße,
Brandy

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

---

Fehler gefunden.

Hatte eine Zeile vergessen, in der der Bauteilpfad übergeben werden sollte.
So sollte es klappen:

Code:

---

Public Sub iPropertiesaendern()

Dim oAssDoc As AssemblyDocument
Set oAssDoc = ThisApplication.ActiveDocument
Dim exapp As Excel.Application
Dim oWorkbook As Excel.workbook
Set exapp = CreateObject("Excel.Application")
Set oWorkbook = exapp.Workbooks.Open("PFAD ZUR EXCELDATEI")                'Noch den Pfad zu deiner ExcelDatei einfügen
exapp.Visible = True                                                      'Diese Zeile löschen, wenn Excel unsichtbar bleiben soll
Dim Propset As propertyset
Dim iProp As Property

Set Propset = oAssDoc.PropertySets("Inventor Summary Information")
Set iProp = Propset.ItemByPropId(9)

Dim i As Integer
i = 1
Do
If oWorkbook.ActiveSheet.Cells(i, 1).Value <> "" Then                                'Prüft auf leere Zelle
If iProp.Expression = oWorkbook.Sheets.Item("Nomenklatur").Cells(i, 1).Value Then    'Vergleicht iProp-Inhalt mit cells(Zeile, Spalte 1)
iProp.Expression = oWorkbook.ActiveSheet.Cells(i, 2).Value                          'Wenn passend ersetzen mit Wert aus cells(Zeile, Spalte 2)
Exit Do
Else: i = i + 1                                                                      'Sonst Zeile erhöhen
End If
Else: Exit Do
End If
Loop

Dim oOccurrence As ComponentOccurrence
Dim oPath As String

For Each oOccurrence In oAssDoc.ComponentDefinition.Occurrences
If oOccurrence.DefinitionDocumentType = kAssemblyDocumentObject Then
oPath = oOccurrence.ReferencedDocumentDescriptor.FullDocumentName
Call baugruppe(oPath, oWorkbook)
ElseIf oOccurrence.DefinitionDocumentType = kPartDocumentObject Then
oPath = oOccurrence.ReferencedDocumentDescriptor.FullDocumentName          '<--- Zeile vergessen gehabt
Call bauteil(oPath, oWorkbook)
End If
Next
oAssDoc.Update2
oAssDoc.Save2
oAssDoc.Close
oWorkbook.Saved = True
oWorkbook.Close
exapp.Quit
End Sub

Private Function baugruppe(ByVal oPath As String, ByVal oWorkbook As Excel.workbook)
Dim Propset As propertyset
Dim iProp As Property
Dim oAssDoc As AssemblyDocument
Set oAssDoc = ThisApplication.Documents.Open(oPath, False)

Set Propset = oAssDoc.PropertySets("Inventor Summary Information")
Set iProp = Propset.Item(9)

Dim i As Integer
i = 1
Do
If oWorkbook.Sheets.Item("Nomenklatur").Cells(i, 1).Value <> "" Then
If iProp.Expression = oWorkbook.ActiveSheet.Cells(i, 1).Value Then
iProp.Expression = oWorkbook.ActiveSheet.Cells(i, 2).Value
Exit Do
Else: i = i + 1
End If
Else: Exit Do
End If
Loop

Dim oOcc As ComponentOccurrence
For Each oOccurrence In oAssDoc.ComponentDefinition.Occurrences
If oOccurrence.DefinitionDocumentType = kAssemblyDocumentObject Then
oPath = oOccurrence.ReferencedDocumentDescriptor.FullDocumentName

Call baugruppe(oPath, oWorkbook)
ElseIf oOccurrence.DefinitionDocumentType = kPartDocumentObject Then
oPath = oOccurrence.ReferencedDocumentDescriptor.FullDocumentName
Call bauteil(oPath, oWorkbook)
End If
Next
oAssDoc.Update2
oAssDoc.Save2
oAssDoc.Close

End Function
Private Function bauteil(ByVal oPath As String, ByVal oWorkbook As Excel.workbook)
Dim oPartdoc As PartDocument
Set oPartdoc = ThisApplication.Documents.Open(oPath)

Dim Propset As propertyset
Dim iProp As Property
Set Propset = oPartdoc.PropertySets("Inventor Summary Information")
Set iProp = Propset.Item(9)

Dim i As Integer
i = 1
Do
If oWorkbook.Sheets("Nomenklatur").Cells(i, 1).Value <> "" Then
If iProp.Expression = oWorkbook.ActiveSheet.Cells(i, 1).Value Then
iProp.Expression = oWorkbook.ActiveSheet.Cells(i, 2).Value
Exit Do
Else: i = i + 1
End If
Else: Exit Do
End If
Loop

oPartdoc.Update2
oPartdoc.Save2
oPartdoc.Close

End Function

---

------------------
MFG

Chris

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

---

Vielen Dank Chris,

damit läuft es perfekt.

Grüße,
Brandy

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

---

Hi Chris,

habe das Makro auch ausprobiert und es funktioniert gut!
Leider öffnet es bei großen Assemblies aber alle Bauteile nacheinander, d.h. auch Inhaltscenter Teile usw.
Das Öffnen der Tabs im Inventor benötigt dafür gefühlt am meisten Zeit.

Könnte man schon vor dem öffnen der Parts anhand deren iProp (Revisionsnummer)überprüfen, ob dieses Bauteil überhaupt in der Excel-Liste vorkommt und sich das Öffnen / Ändern / Speichern sparen?

Viele Grüße

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

---

Hi,

Vor dem Öffnen auf iProps prüfen könnte gehen, aber nur auf Umwegen.
Einfacher wäre in dem Fall sicher die Prüfung, ob es ein ContentCenterPart ist und wenn ja, dann zu überspringen.

------------------
MFG

Chris

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

---

Alright, danke!

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