---

Browserbaum.png

Hallo zusammen,

ich benötige mal wieder eure Hilfe, da ich nicht weiterkomme.
Ich habe ein iLogic-Programm geschrieben, das alle Unterbaugruppen und Bauteile in einer Baugruppe durchsucht und dort benutzerdefinierte Eigenschaften ergänzt, die aus einer Exceltabelle gelesen werden.

Beim Öffnen von Baugruppen oder Bauteilen, die in einem benannten Modellzustand (und nicht im Primär-Modellzustand) abgespeichert sind, kommt eine Fehlermeldung, dass diese Baugruppe nicht gefunden werden kann. Der Grund ist wohl, dass im Anzeigename (Displayname) auch noch der Name des Modellzustandes ("ein Abschlag") angehängt ist.
Ich habe es auch schon mit "fullfilename" versucht, doch das funktioniert auch nicht.

Die Fehlermeldung lautet:

Fehler in Zeile 168 in Regel z_Pfaffensteig-Eigenschaften_in_Baugruppen_und_Bauteilen, in Dokument 23075801-Mengentest_VKL-6A-K1.iam

iProperties: Die Komponente mit dem Namen "23075801-VKL-6A-K-1-BauGruppe_Export_240930.iam (ein Abschlag)" wurde nicht gefunden.

Der Fehler tritt in der Funktion auf, wenn versucht wird, in der Datei mit dem Displayname die Eigenschaft zu schreiben.

Kann mir jemand helfen, wie ich die Eigenschaft in der Unterbaugruppe, die in einem benannten Modellzustand abgespeichert wurde und mit dem Displayname angesprochen wird, schreiben kann?

Wie kann ich den Displaynamen der Baugruppe ohne den Zusatz des Modellzustandes verwenden?
An welcher Stelle muss der Code wie abgeändert werden?

Hier ist mein Programm-code:

Code:

---

'******************************************************************************************************************************
' Diese Programm erzeugt in Bauteilen (*.ipt) und/oder Baugruppen (*.iam) benutzerdefinierte Eigenschaften, die aus einer
' Exceltabelle eingelesen werden. Das Programm erzeugt die Eigenschaften in Baugruppen, Unterbaugruppen und den einzelnen
' Bauteilen in den Baugruppen und Unterbaugruppen.
'
' Das Programm ist dazu gedacht, die im Projekt Pfaffensteigtunnel definierten Eigenschaften als benutzerdefinierte iProperties
' in den Baugruppen udn Bauteilen anzulegen, damit diese für die BIM-Prozesse verwendet werden können.
'******************************************************************************************************************************

Sub Main()

Dim i As Integer
Dim Nummer_Eigenschaft As Integer

'*************************
'Prüfung, ob ein Bauteil oder eine Baugruppe geöffnet und aktiv ist
'*************************
If Not ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject And Not ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
MessageBox.Show("Die aktive Datei ist kein Beuteil oder keine Baugruppe!" & Chr(13) & Chr(13) & "Ein Bauteil (*.ipt) oder eine Baugruppe (*.iam) muss geöffnet bzw. aktiv sein.", "Inventor")
Exit Sub
End If


'*************************
'Dateiauswahl für Exceltabelle mit benutzerdefinierten Projekt-Eigenschaften für Bauteile oder Baugruppen
'*************************
Dim oFileDlg_Tabelle As Inventor.FileDialog = Nothing
ThisApplication.CreateFileDialog(oFileDlg_Tabelle)

Try
'oFileDlg_Tabelle.Filter = "XML Files (*.xml)|*.xml"
oFileDlg_Tabelle.Filter = "Excel Files (*.xls;*.xlsx;*.xlsm)|*.xls;*.xlsx;*.xlsm"
'oFileDlg_Tabelle.Filter = "Text Files (*.txt;*.csv)|*.txt;*.csv"
oFileDlg_Tabelle.DialogTitle = "Auswahl Tabelle mit benutzerdefinierten Eigenscahften aus dem VAULT"
oFileDlg_Tabelle.InitialDirectory = ThisDoc.Path
oFileDlg_Tabelle.CancelError = True
oFileDlg_Tabelle.ShowOpen()

If oFileDlg_Tabelle.FileName <> "" Then
Eigenschaftentabelle = oFileDlg_Tabelle.FileName
'MessageBox.Show("Es wurde die folgende Datei mit Eigenschaften ausgewählt:" & Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Auswahl getätigt")
End If

Catch
MessageBox.Show("Keine Datei ausgewählt. Das Programm wird beendet.", "Dialog Abbruch")
Exit Sub
End Try

'*************************
'Anzahl Zeilen in Tabelle ermitteln
'*************************

GoExcel.TitleRow = 2
GoExcel.FindRowStart = 3

Dim Zeilen_Tabelle As Integer
Dim Anzahl_Eigenschaften As Integer
Zeilen_Tabelle = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "<=", 50000)
Anzahl_Eigenschaften = Zeilen_Tabelle - 6
MessageBox.Show("In der ausgewählten Tabelle ist folgende Anzahl an Zeilen enthalten:" & Chr(13) & _
Anzahl_Eigenschaften & Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Anzahl Zeilen", MessageBoxButtons.OK, MessageBoxIcon.Information)

'*************************
'Eigenschaften aus Tabelle lesen und in Bauteil / Baugruppe erstellen
'*************************

Nummer_Eigenschaft = 0
Erzeugte_Eigenschaft = 0

Dim iCount As Integer
iCount = 1

'Für die Haupt-Baugruppe
If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Or ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then

For i = 1 To Anzahl_Eigenschaften

ZeilenNr = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "=", i)
Eigenschaftenname = GoExcel.CurrentRowValue("C")
Wert = GoExcel.CurrentRowValue("Name")
Datentyp = GoExcel.CurrentRowValue("Einheiten")
Typ = GoExcel.CurrentRowValue("Typ")

If Typ = "Eigenschaft" Then
Zähler_Eigenschaft = iPropertieCheck("", "Custom", Eigenschaftenname, "ND") 'Aufruf der Funktion "iPropertieCheck"
Erzeugte_Eigenschaft = Erzeugte_Eigenschaft + Zähler_Eigenschaft
Nummer_Eigenschaft = Nummer_Eigenschaft + 1
End If

Next

End If

'Für jedes Bauteil und jede Unterbaugruppe in der Haupt-Baugruppe
If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then

Dim oApp As Inventor.Application = ThisApplication
Dim oAssyDoc As Inventor.AssemblyDocument = oApp.ActiveDocument

For Each oSubDoc As Inventor.Document In oAssyDoc.AllReferencedDocuments

    If oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kPartDocumentObject Or oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kAssemblyDocumentObject Then

Try
'Wenn das Bauteil ein Inhaltcenter-Bauteil ist, dann überspringe das Bauteil
oCustomPropertySet = oSubDoc.PropertySets.Item("2DB9508F-CBA8-4714-ABE9-1A0EDB5B586C") 'ContentCenter in VBA
Exit Try

Catch
'Wenn das Bauteil ein "normales" Bauteil ist, dann erstelle die Eigenschaften
oCustomPropertySet = oSubDoc.PropertySets.Item("D5CDD505-2E9C-101B-9397-08002B2CF9AE") 'benutzerdefinierte iProperties


For i = 1 To Anzahl_Eigenschaften

ZeilenNr = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "=", i)
Eigenschaftenname = GoExcel.CurrentRowValue("C")
Wert = GoExcel.CurrentRowValue("Name")
Datentyp = GoExcel.CurrentRowValue("Einheiten")
Typ = GoExcel.CurrentRowValue("Typ")

If Typ = "Eigenschaft" Then
Zähler_Eigenschaft = iPropertieCheck(oSubDoc.DisplayName, "Custom", Eigenschaftenname, "ND") 'Aufruf der Funktion "iPropertieCheck"
' Zähler_Eigenschaft = iPropertieCheck(oSubDoc.fullfilename, "Custom", Eigenschaftenname, "ND") 'Aufruf der Funktion "iPropertieCheck"
Erzeugte_Eigenschaft = Erzeugte_Eigenschaft + Zähler_Eigenschaft
Nummer_Eigenschaft = Nummer_Eigenschaft + 1
End If

Next

End Try
    End If
   
iCount = iCount + 1

Next

End If

MessageBox.Show("Es wurden alle fehlenden iProperties in den verbauten Baugruppen und Bauteilen angelegt." & Chr(13) & Chr(13) _
& "Es wurden insgesamt " & Nummer_Eigenschaft & " eindeutige Eigenschaften gelesen." & Chr(13) & Chr(13) _
& "Es wurden in insgesamt " & iCount & " Bauteilen und Baugruppen die Eigenschaften erstellt." & Chr(13) & Chr(13) _
& "Es wurden in Summe " & Erzeugte_Eigenschaft & " neue Eigenschaften in den Bauteilen und Baugruppen angelegt." & Chr(13) _
& "Die restlichen Eigenschaften sind bereits vorhanden", "iPropertie", MessageBoxButtons.OK, MessageBoxIcon.Information)

End Sub

'****************************************
'Funktion Prüfung iProperty und ergänzen
'****************************************

Private Function iPropertieCheck(Bauteilname As String, Reiter As String, Eigenschaft As String, Eigenschaftswert As String)
Try
iProp = iProperties.Value(Bauteilname, Reiter, Eigenschaft)
Catch
' MessageBox.Show("Das iPropertie """ & Eigenschaft & """ wurde nicht gefunden." & vbLf & vbLf & "Das iPropertie """ & Eigenschaft & """ wird in der Datei angelegt." _
' & vbLf & vbLf & "Der Inhalt des iPropertie ist: " & Eigenschaftswert, "iPropertie", MessageBoxButtons.OK, MessageBoxIcon.Information)

iProperties.Value(Bauteilname, Reiter, Eigenschaft) = Eigenschaftswert

Zähler_Eigenschaft = 1
Return Zähler_Eigenschaft

End Try

End Function

---

Vielen Dank für eure Unterstützung.
Schöne Grüße
Stephan

[Diese Nachricht wurde von FroSte am 02. Okt. 2024 editiert.]

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

---

Moin

Wenn es ein ModelStateMember ist, sollte der benötigte DisplayName im FactoryDocument stehen. Probier mal so:

Code:

---

'******************************************************************************************************************************
' Diese Programm erzeugt in Bauteilen (*.ipt) und/oder Baugruppen (*.iam) benutzerdefinierte Eigenschaften, die aus einer
' Exceltabelle eingelesen werden. Das Programm erzeugt die Eigenschaften in Baugruppen, Unterbaugruppen und den einzelnen
' Bauteilen in den Baugruppen und Unterbaugruppen.
'
' Das Programm ist dazu gedacht, die im Projekt Pfaffensteigtunnel definierten Eigenschaften als benutzerdefinierte iProperties
' in den Baugruppen udn Bauteilen anzulegen, damit diese für die BIM-Prozesse verwendet werden können.
'******************************************************************************************************************************

Sub Main()

Dim i As Integer
Dim Nummer_Eigenschaft As Integer

'*************************
'Prüfung, ob ein Bauteil oder eine Baugruppe geöffnet und aktiv ist
'*************************
If Not ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject And Not ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
MessageBox.Show("Die aktive Datei ist kein Beuteil oder keine Baugruppe!" & Chr(13) & Chr(13) & "Ein Bauteil (*.ipt) oder eine Baugruppe (*.iam) muss geöffnet bzw. aktiv sein.", "Inventor")
Exit Sub
End If

'*************************
'Dateiauswahl für Exceltabelle mit benutzerdefinierten Projekt-Eigenschaften für Bauteile oder Baugruppen
'*************************
Dim oFileDlg_Tabelle As Inventor.FileDialog = Nothing
ThisApplication.CreateFileDialog(oFileDlg_Tabelle)

Try
'oFileDlg_Tabelle.Filter = "XML Files (*.xml)|*.xml"
oFileDlg_Tabelle.Filter = "Excel Files (*.xls;*.xlsx;*.xlsm)|*.xls;*.xlsx;*.xlsm"
'oFileDlg_Tabelle.Filter = "Text Files (*.txt;*.csv)|*.txt;*.csv"
oFileDlg_Tabelle.DialogTitle = "Auswahl Tabelle mit benutzerdefinierten Eigenscahften aus dem VAULT"
oFileDlg_Tabelle.InitialDirectory = ThisDoc.Path
oFileDlg_Tabelle.CancelError = True
oFileDlg_Tabelle.ShowOpen()

If oFileDlg_Tabelle.FileName <> "" Then
Eigenschaftentabelle = oFileDlg_Tabelle.FileName
'MessageBox.Show("Es wurde die folgende Datei mit Eigenschaften ausgewählt:" & Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Auswahl getätigt")
End If

Catch
MessageBox.Show("Keine Datei ausgewählt. Das Programm wird beendet.", "Dialog Abbruch")
Exit Sub
End Try

'*************************
'Anzahl Zeilen in Tabelle ermitteln
'*************************

GoExcel.TitleRow = 2
GoExcel.FindRowStart = 3

Dim Zeilen_Tabelle As Integer
Dim Anzahl_Eigenschaften As Integer
Zeilen_Tabelle = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "<=", 50000)
Anzahl_Eigenschaften = Zeilen_Tabelle - 6
MessageBox.Show("In der ausgewählten Tabelle ist folgende Anzahl an Zeilen enthalten:" & Chr(13) & _
Anzahl_Eigenschaften & Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Anzahl Zeilen", MessageBoxButtons.OK, MessageBoxIcon.Information)

'*************************
'Eigenschaften aus Tabelle lesen und in Bauteil / Baugruppe erstellen
'*************************

Nummer_Eigenschaft = 0
Erzeugte_Eigenschaft = 0

Dim iCount As Integer
iCount = 1

'Für die Haupt-Baugruppe
If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Or ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
For i = 1 To Anzahl_Eigenschaften
ZeilenNr = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "=", i)
Eigenschaftenname = GoExcel.CurrentRowValue("C")
Wert = GoExcel.CurrentRowValue("Name")
Datentyp = GoExcel.CurrentRowValue("Einheiten")
Typ = GoExcel.CurrentRowValue("Typ")

If Typ = "Eigenschaft" Then
Zähler_Eigenschaft = iPropertieCheck("", "Custom", Eigenschaftenname, "ND") 'Aufruf der Funktion "iPropertieCheck"
Erzeugte_Eigenschaft = Erzeugte_Eigenschaft + Zähler_Eigenschaft
Nummer_Eigenschaft = Nummer_Eigenschaft + 1
End If
Next
End If

'Für jedes Bauteil und jede Unterbaugruppe in der Haupt-Baugruppe
If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
Dim oApp As Inventor.Application = ThisApplication
Dim oAssyDoc As Inventor.AssemblyDocument = oApp.ActiveDocument

For Each oSubDoc As Inventor.Document In oAssyDoc.AllReferencedDocuments
    If oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kPartDocumentObject Or oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kAssemblyDocumentObject Then
Try
'Wenn das Bauteil ein Inhaltcenter-Bauteil ist, dann überspringe das Bauteil
oCustomPropertySet = oSubDoc.PropertySets.Item("2DB9508F-CBA8-4714-ABE9-1A0EDB5B586C") 'ContentCenter in VBA
Exit Try
Catch
'Wenn das Bauteil ein "normales" Bauteil ist, dann erstelle die Eigenschaften
oCustomPropertySet = oSubDoc.PropertySets.Item("D5CDD505-2E9C-101B-9397-08002B2CF9AE") 'benutzerdefinierte iProperties

For i = 1 To Anzahl_Eigenschaften
ZeilenNr = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "=", i)
Eigenschaftenname = GoExcel.CurrentRowValue("C")
Wert = GoExcel.CurrentRowValue("Name")
Datentyp = GoExcel.CurrentRowValue("Einheiten")
Typ = GoExcel.CurrentRowValue("Typ")

If Typ = "Eigenschaft" Then
Zähler_Eigenschaft = iPropertieCheck(GetDisplayName(oSubDoc),"Custom", Eigenschaftenname, "ND") 'Aufruf der Funktion "iPropertieCheck"
' Zähler_Eigenschaft = iPropertieCheck(oSubDoc.fullfilename, "Custom", Eigenschaftenname, "ND") 'Aufruf der Funktion "iPropertieCheck"
Erzeugte_Eigenschaft = Erzeugte_Eigenschaft + Zähler_Eigenschaft
Nummer_Eigenschaft = Nummer_Eigenschaft + 1
End If
Next
End Try
    End If
 
iCount = iCount + 1
Next
End If

MessageBox.Show("Es wurden alle fehlenden iProperties in den verbauten Baugruppen und Bauteilen angelegt." & Chr(13) & Chr(13) _
& "Es wurden insgesamt " & Nummer_Eigenschaft & " eindeutige Eigenschaften gelesen." & Chr(13) & Chr(13) _
& "Es wurden in insgesamt " & iCount & " Bauteilen und Baugruppen die Eigenschaften erstellt." & Chr(13) & Chr(13) _
& "Es wurden in Summe " & Erzeugte_Eigenschaft & " neue Eigenschaften in den Bauteilen und Baugruppen angelegt." & Chr(13) _
& "Die restlichen Eigenschaften sind bereits vorhanden", "iPropertie", MessageBoxButtons.OK, MessageBoxIcon.Information)

End Sub

'****************************************
'Funktion Prüfung iProperty und ergänzen
'****************************************

Private Function iPropertieCheck(Bauteilname As String, Reiter As String, Eigenschaft As String, Eigenschaftswert As String) As Integer
Try
iProp = iProperties.Value(Bauteilname, Reiter, Eigenschaft)
Catch
' MessageBox.Show("Das iPropertie """ & Eigenschaft & """ wurde nicht gefunden." & vbLf & vbLf & "Das iPropertie """ & Eigenschaft & """ wird in der Datei angelegt." _
' & vbLf & vbLf & "Der Inhalt des iPropertie ist: " & Eigenschaftswert, "iPropertie", MessageBoxButtons.OK, MessageBoxIcon.Information)

iProperties.Value(Bauteilname, Reiter, Eigenschaft) = Eigenschaftswert

Zähler_Eigenschaft = 1
Return Zähler_Eigenschaft
End Try
End Function

Private Function GetDisplayName(oTeil As Inventor.Document) As String
If oTeil.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
Return GetDisplayName(DirectCast(oTeil,Inventor.PartDocument))
Else
Return GetDisplayName(DirectCast(oTeil,Inventor.AssemblyDocument))
End If
End Function

Private Function GetDisplayName(oBauteil As Inventor.PartDocument) As String
If oBauteil.ComponentDefinition.IsModelStateMember = True Then
oBauteil = DirectCast(oBauteil.ComponentDefinition.FactoryDocument,Inventor.PartDocument)
End If
Return oBauteil.DisplayName
End Function

Private Function GetDisplayName(oBaugruppe As Inventor.AssemblyDocument) As String
If oBaugruppe.ComponentDefinition.IsModelStateMember = True Then
oBaugruppe = DirectCast(oBaugruppe.ComponentDefinition.FactoryDocument,Inventor.PartDocument)
End If
Return oBaugruppe.DisplayName
End Function

---

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

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

---

Hallo Ralf,

vielen Dank für Deine Hilfe und Deinen Lösungsvorschlag. Leider funktioniert der nicht. Ich erhalte eine Fehlermeldung.

Fehler in Zeile 170 in Regel z_Pfaffensteig-Eigenschaften_in_Baugruppen_und_Bauteilen_Kopieren, in Dokument 23075801-Mengentest_VKL-6A-K1.iam

Unable to cast COM object of type 'System.__ComObject' to interface type 'Inventor.PartDocument'. This operation failed because the QueryInterface call on the COM component for the interface with IID '{29F0D463-C114-11D2-B77F-0060B0F159EF}' failed due to the following error: Schnittstelle nicht unterstützt (0x80004002 (E_NOINTERFACE)).

Unter weitere Infos wird folgendes angegeben:
System.InvalidCastException: Unable to cast COM object of type 'System.__ComObject' to interface type 'Inventor.PartDocument'. This operation failed because the QueryInterface call on the COM component for the interface with IID '{29F0D463-C114-11D2-B77F-0060B0F159EF}' failed due to the following error: Schnittstelle nicht unterstützt (0x80004002 (E_NOINTERFACE)).
  bei ThisRule.GetDisplayName(AssemblyDocument oBaugruppe) in Externe Regel: z_Pfaffensteig-Eigenschaften_in_Baugruppen_und_Bauteilen_Kopieren:Zeile 170
  bei ThisRule.GetDisplayName(Document oTeil) in Externe Regel: z_Pfaffensteig-Eigenschaften_in_Baugruppen_und_Bauteilen_Kopieren:Zeile 157
  bei ThisRule.Main() in Externe Regel: z_Pfaffensteig-Eigenschaften_in_Baugruppen_und_Bauteilen_Kopieren:Zeile 114
  bei Autodesk.iLogic.Exec.AppDomExec.ExecRuleInAssembly(Assembly assem)
  bei Autodesk.iLogic.Exec.AppDomExec.ExecCodeHere()
  bei Autodesk.iLogic.Exec.AppDomExec.ExecCodeInOtherDomain(AppDomain otherDomain, String assemName)
  bei iLogic.RuleEvalContainer.ExecRuleEval(String execRule)

Leider bin ich noch zu unerfahren, um damit wirklich etwas anfangen zu können.
Hast Du eine Idee, was da schief läuft?

Danke.
Gruß Stephan

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

---

Moin

In der letzten Funktion ist ein Fehler. Ersetz die mal bitte mit:

Code:

---

Private Function GetDisplayName(oBaugruppe As Inventor.AssemblyDocument) As String
    If oBaugruppe.ComponentDefinition.IsModelStateMember = True Then
        oBaugruppe = DirectCast(oBaugruppe.ComponentDefinition.FactoryDocument,Inventor.AssemblyDocument)
    End If
    Return oBaugruppe.DisplayName
End Function

---

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

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

---

Hallo Ralf,

vielen Dank für Deine Unterstützung. Ich war die letzten Wochen viel auf Dienstreisen unterwegs, so dass ich mich erst heute wieder der Programmierung und dem Problem zuwenden kann.

Die Korrektur hat geholfen und bei Baugruppen mit Unterbaugruppen und mit Bauteilen funktioniert das nun perfekt.

Allerdings habe ich nun noch eine Ausnahme, die zu einem Fehler führt. Ich habe in meinen Baugruppen teilweise auch noch iParts und / oder iAssemblies verbaut. An diesen steigt der Code mit einer Fehlermeldung aus.

Fehler in Zeile 146 in Regel z_Pfaffensteig-Eigenschaften_in_Baugruppen_und_Bauteilen_Kopieren, in Dokument 20240524_iPart_Baugruppe.iam

Unbekannter Fehler (0x80004005 (E_FAIL))

Bei "weitere Infos" steht folgendes:

System.Runtime.InteropServices.COMException (0x80004005): Unbekannter Fehler (0x80004005 (E_FAIL))
  bei System.RuntimeType.InvokeMember(String name, BindingFlags bindingFlags, Binder binder, Object target, Object[] providedArgs, ParameterModifier[] modifiers, CultureInfo culture, String[] namedParams)
  bei System.RuntimeType.ForwardCallToInvokeMember(String memberName, BindingFlags flags, Object target, Object[] aArgs, Boolean[] aArgsIsByRef, Int32[] aArgsWrapperTypes, Type[] aArgsTypes, Type retType)
  bei Inventor.PropertySet.Add(Object PropValue, Object Name, Object PropId)
  bei iLogic.CadPropertiesInRule.InvPropertyInSets(PropertySets propSets, String setName, String propName, Boolean createCustom)
  bei iLogic.CadPropertiesInRule.set_Value(Object compoOrDocName, String setName, String propName, Object value)
  bei ThisRule.iPropertieCheck(String Bauteilname, String Reiter, String Eigenschaft, String Eigenschaftswert) in Externe Regel: z_Pfaffensteig-Eigenschaften_in_Baugruppen_und_Bauteilen_Kopieren:Zeile 146
  bei ThisRule.Main() in Externe Regel: z_Pfaffensteig-Eigenschaften_in_Baugruppen_und_Bauteilen_Kopieren:Zeile 114
  bei Autodesk.iLogic.Exec.AppDomExec.ExecRuleInAssembly(Assembly assem)
  bei Autodesk.iLogic.Exec.AppDomExec.ExecCodeHere()
  bei Autodesk.iLogic.Exec.AppDomExec.ExecCodeInOtherDomain(AppDomain otherDomain, String assemName)
  bei iLogic.RuleEvalContainer.ExecRuleEval(String execRule)

Ich vermute, dass versucht wird, in den Varianten des iParts die iProperties zu ändern, was nicht gehen kann, da die iProperties der Varianten in der Familie (ipart oder iAssembly) definiert werden. Es können höchstens die iProperties der Familiendefinition (iPart-Datei oder iAssembly-Datei) geändert werden. Richtig?
Lässt es sich abfangen, dass iProperties von den Varianten der iParts und iAssemblies nicht geändert werden und es zu keinem Fehler mehr kommt?

Vleien lieben Danke nochmals für Deine Unterstützung.

Schöne Grüße
Stephan

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

---

Moin

Member von iParts und iAssemblies können so nicht verändert werden. Sie sind schreibgeschützt, daher kommt der Fehler wenn versucht wird das nicht vorhandene iProp zu erzeugen. Das sieht man in der dritten Zeile der ersten Felhermeldung:

Code:

---

bei Inventor.PropertySet.Add(Object PropValue, Object Name, Object PropId)

---

In der dritten Zeile steht in aller Regel immer der relevante Teil. Der Rest ist für die meisten eher verwirrend.
Es läßt sich abfragen, ob die Dokumente i-irgendwas sind und auch ob es Inhaltscenterteile sind. Ebenso gibt es noch ein pauschales isModifyable, bei dem ich mir aber auch nicht sicher bin, wann das gesetzt wird. Anbei mal nur die angepaßte Sub Main. Die Prüfung ist jetzt einfach dazwischen gequetscht. Nicht schön, sollte aber erstmal laufen.

Code:

---

Sub Main()

Dim i As Integer
Dim Nummer_Eigenschaft As Integer

'*************************
'Prüfung, ob ein Bauteil oder eine Baugruppe geöffnet und aktiv ist
'*************************
If Not ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject And Not ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
MessageBox.Show("Die aktive Datei ist kein Beuteil oder keine Baugruppe!" & Chr(13) & Chr(13) & "Ein Bauteil (*.ipt) oder eine Baugruppe (*.iam) muss geöffnet bzw. aktiv sein.", "Inventor")
Exit Sub
End If

'*************************
'Dateiauswahl für Exceltabelle mit benutzerdefinierten Projekt-Eigenschaften für Bauteile oder Baugruppen
'*************************
Dim oFileDlg_Tabelle As Inventor.FileDialog = Nothing
ThisApplication.CreateFileDialog(oFileDlg_Tabelle)

Try
'oFileDlg_Tabelle.Filter = "XML Files (*.xml)|*.xml"
oFileDlg_Tabelle.Filter = "Excel Files (*.xls;*.xlsx;*.xlsm)|*.xls;*.xlsx;*.xlsm"
'oFileDlg_Tabelle.Filter = "Text Files (*.txt;*.csv)|*.txt;*.csv"
oFileDlg_Tabelle.DialogTitle = "Auswahl Tabelle mit benutzerdefinierten Eigenscahften aus dem VAULT"
oFileDlg_Tabelle.InitialDirectory = ThisDoc.Path
oFileDlg_Tabelle.CancelError = True
oFileDlg_Tabelle.ShowOpen()

If oFileDlg_Tabelle.FileName <> "" Then
Eigenschaftentabelle = oFileDlg_Tabelle.FileName
'MessageBox.Show("Es wurde die folgende Datei mit Eigenschaften ausgewählt:" & Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Auswahl getätigt")
End If

Catch
MessageBox.Show("Keine Datei ausgewählt. Das Programm wird beendet.", "Dialog Abbruch")
Exit Sub
End Try

'*************************
'Anzahl Zeilen in Tabelle ermitteln
'*************************

GoExcel.TitleRow = 2
GoExcel.FindRowStart = 3

Dim Zeilen_Tabelle As Integer
Dim Anzahl_Eigenschaften As Integer
Zeilen_Tabelle = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "<=", 50000)
Anzahl_Eigenschaften = Zeilen_Tabelle - 6
MessageBox.Show("In der ausgewählten Tabelle ist folgende Anzahl an Zeilen enthalten:" & Chr(13) & _
Anzahl_Eigenschaften & Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Anzahl Zeilen", MessageBoxButtons.OK, MessageBoxIcon.Information)

'*************************
'Eigenschaften aus Tabelle lesen und in Bauteil / Baugruppe erstellen
'*************************

Nummer_Eigenschaft = 0
Erzeugte_Eigenschaft = 0

Dim iCount As Integer
iCount = 1

'Für die Haupt-Baugruppe
If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Or ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
For i = 1 To Anzahl_Eigenschaften
ZeilenNr = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "=", i)
Eigenschaftenname = GoExcel.CurrentRowValue("C")
Wert = GoExcel.CurrentRowValue("Name")
Datentyp = GoExcel.CurrentRowValue("Einheiten")
Typ = GoExcel.CurrentRowValue("Typ")

If Typ = "Eigenschaft" Then
Zähler_Eigenschaft = iPropertieCheck("", "Custom", Eigenschaftenname, "ND") 'Aufruf der Funktion "iPropertieCheck"
Erzeugte_Eigenschaft = Erzeugte_Eigenschaft + Zähler_Eigenschaft
Nummer_Eigenschaft = Nummer_Eigenschaft + 1
End If
Next
End If

'Für jedes Bauteil und jede Unterbaugruppe in der Haupt-Baugruppe
If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
Dim oApp As Inventor.Application = ThisApplication
Dim oAssyDoc As Inventor.AssemblyDocument = oApp.ActiveDocument

For Each oSubDoc As Inventor.Document In oAssyDoc.AllReferencedDocuments
    If oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kPartDocumentObject Or oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kAssemblyDocumentObject Then
Try
'Wenn das Bauteil ein Inhaltcenter-Bauteil ist, dann überspringe das Bauteil
oCustomPropertySet = oSubDoc.PropertySets.Item("2DB9508F-CBA8-4714-ABE9-1A0EDB5B586C") 'ContentCenter in VBA
Exit Try
Catch
If oSubDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
Dim oPartDoc As PartDocument = DirectCast(oSubDoc,PartDocument)
If oPartDoc.ComponentDefinition.IsContentMember = True Then Continue For
If oPartDoc.ComponentDefinition.IsiPartMember = True Then Continue For
If oPartDoc.ComponentDefinition.IsiPartFactory = True Then Continue For
If oPartDoc.IsModifiable= False Then Continue For
End If
If oSubDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
Dim oAssDoc As AssemblyDocument = DirectCast(oSubDoc,AssemblyDocument)
If oAssDoc.ComponentDefinition.IsiAssemblyMember= True Then Continue For
If oAssDoc.ComponentDefinition.IsiAssemblyFactory = True Then Continue For
If oAssDoc.IsModifiable= False Then Continue For
End If

'Wenn das Bauteil ein "normales" Bauteil ist, dann erstelle die Eigenschaften
oCustomPropertySet = oSubDoc.PropertySets.Item("D5CDD505-2E9C-101B-9397-08002B2CF9AE") 'benutzerdefinierte iProperties

For i = 1 To Anzahl_Eigenschaften
ZeilenNr = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "=", i)
Eigenschaftenname = GoExcel.CurrentRowValue("C")
Wert = GoExcel.CurrentRowValue("Name")
Datentyp = GoExcel.CurrentRowValue("Einheiten")
Typ = GoExcel.CurrentRowValue("Typ")

If Typ = "Eigenschaft" Then
Zähler_Eigenschaft = iPropertieCheck(GetDisplayName(oSubDoc),"Custom", Eigenschaftenname, "ND") 'Aufruf der Funktion "iPropertieCheck"
' Zähler_Eigenschaft = iPropertieCheck(oSubDoc.fullfilename, "Custom", Eigenschaftenname, "ND") 'Aufruf der Funktion "iPropertieCheck"
Erzeugte_Eigenschaft = Erzeugte_Eigenschaft + Zähler_Eigenschaft
Nummer_Eigenschaft = Nummer_Eigenschaft + 1
End If
Next
End Try
    End If

iCount = iCount + 1
Next
End If

MessageBox.Show("Es wurden alle fehlenden iProperties in den verbauten Baugruppen und Bauteilen angelegt." & Chr(13) & Chr(13) _
& "Es wurden insgesamt " & Nummer_Eigenschaft & " eindeutige Eigenschaften gelesen." & Chr(13) & Chr(13) _
& "Es wurden in insgesamt " & iCount & " Bauteilen und Baugruppen die Eigenschaften erstellt." & Chr(13) & Chr(13) _
& "Es wurden in Summe " & Erzeugte_Eigenschaft & " neue Eigenschaften in den Bauteilen und Baugruppen angelegt." & Chr(13) _
& "Die restlichen Eigenschaften sind bereits vorhanden", "iPropertie", MessageBoxButtons.OK, MessageBoxIcon.Information)

End Sub

---

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

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

---

Hallo Ralf,
vielen Dank für Deine Unterstützung. Jetzt funktioniert es so, wie ich es wollte.
Gruß Stephan

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

---

Ubung.zip

Hallo Ralf,

jetzt komme ich doch nochmal auf Dich zurück. Ich habe inzwischen den Code noch mit einer Funktion erweitert, die zusätzlich zu den benutzerdefinierten iProperties auch noch Benutzerparameter mit einer MultiValue-Liste in eine Baugruppen und die Unterbaugruppen mit Bauteilen einfügen soll.
Mein Code funktioniert auch einiger maßen, doch nicht ganz zuverlässig bzw. nicht ganz so wie er soll.
Die Benutzerparameter sollen ebenfalls in allen Bauteilen und Unterbaugruppen mit deren Bauteilen erstellt werden. In der Hauptbaugruppe funktioniert der Code prima. Es werden aber keine Benutzerparameter in den Unterbaugruppen und den Bauteilen erstellt.
Wendie ich den Code auf eine Baugruppe nur mit Bauteilen an, dann werden zwar Benutzerparameter angelegt, aber nicht vollständig bzw. teilweise ohne die Auswahllisten. Wird der Code in einem einzelnen Bauteil ausgeführt, werden gar keine Benutzerparameter angelegt.

Ich kann nicht nachvollziehen, woran das liegt. Mit den benutzerdefinierten iProperties klappt das ja problemlos.
Habe ich die Funktion "BenutzerParameterAnlegen" an der falschen Stelle aufgerufen, dass sie nicht auf die Unterbaugruppe und Bauteile angewendet wird? Muss ich die Funktion noch anpassen, damit sie auch für Unterbaugruppen und Bauteile richtig funktioniert?

Ich lege die Tabelle, aus der ich die Daten auslese und ein einfaches Model bei.

Könntest Du bitte nochmals auf en code schauen und mir weiterhelfen?
Das wäre sehr lieb von Dir.

Gruß Stephan

Code:

---

'******************************************************************************************************************************
' Diese Programm erzeugt in Bauteilen (*.ipt) und/oder Baugruppen (*.iam) benutzerdefinierte Eigenschaften, die aus einer
' Exceltabelle eingelesen werden. Das Programm erzeugt die Eigenschaften in Baugruppen, Unterbaugruppen und den einzelnen
' Bauteilen in den Baugruppen und Unterbaugruppen.
' Buteilvarianten von iParts oder Baugruppenvarianten von iAssemblies werden ausgelassen, da von diesen die iProperties nicht
' geändert werden können
'
' Das Programm ist dazu gedacht, die im Projekt Pfaffensteigtunnel definierten Eigenschaften als benutzerdefinierte iProperties
' in den Baugruppen und Bauteilen anzulegen, damit diese für die BIM-Prozesse verwendet werden können.
'******************************************************************************************************************************

Sub Main()

Dim i As Integer
Dim Nummer_Eigenschaft As Integer

'********************************************************************
'Prüfung, ob ein Bauteil oder eine Baugruppe geöffnet und aktiv ist
'********************************************************************
If Not ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject And Not ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
MessageBox.Show("Die aktive Datei ist kein Beuteil oder keine Baugruppe!" & Chr(13) & Chr(13) & "Ein Bauteil (*.ipt) oder eine Baugruppe (*.iam) muss geöffnet bzw. aktiv sein.", "Inventor")
Exit Sub
End If

'**********************************************************************************************************
'Dateiauswahl für Exceltabelle mit benutzerdefinierten Projekt-Eigenschaften für Bauteile oder Baugruppen
'**********************************************************************************************************
Dim oFileDlg_Tabelle As Inventor.FileDialog = Nothing
ThisApplication.CreateFileDialog(oFileDlg_Tabelle)

Try
'oFileDlg_Tabelle.Filter = "XML Files (*.xml)|*.xml"
oFileDlg_Tabelle.Filter = "Excel Files (*.xls;*.xlsx;*.xlsm)|*.xls;*.xlsx;*.xlsm"
'oFileDlg_Tabelle.Filter = "Text Files (*.txt;*.csv)|*.txt;*.csv"
oFileDlg_Tabelle.DialogTitle = "Auswahl Tabelle mit benutzerdefinierten Eigenscahften aus dem VAULT"
oFileDlg_Tabelle.InitialDirectory = ThisDoc.Path
oFileDlg_Tabelle.CancelError = True
oFileDlg_Tabelle.ShowOpen()

If oFileDlg_Tabelle.FileName <> "" Then
Eigenschaftentabelle = oFileDlg_Tabelle.FileName
'MessageBox.Show("Es wurde die folgende Datei mit Eigenschaften ausgewählt:" & Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Auswahl getätigt")
End If

Catch
MessageBox.Show("Keine Datei ausgewählt. Das Programm wird beendet.", "Dialog Abbruch")
Exit Sub
End Try

'***********************************
'Anzahl Zeilen in Tabelle ermitteln
'***********************************

GoExcel.TitleRow = 2
GoExcel.FindRowStart = 3

Dim Zeilen_Tabelle As Integer
Dim Anzahl_Eigenschaften As Integer

Zeilen_Tabelle = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "<=", 50000)
Anzahl_Eigenschaften = Zeilen_Tabelle - 2
MessageBox.Show("In der ausgewählten Tabelle ist folgende Anzahl an Zeilen enthalten:" & Chr(13) & _
Anzahl_Eigenschaften & Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Anzahl Zeilen", MessageBoxButtons.OK, MessageBoxIcon.Information)

'*********************************************************************
'Eigenschaften aus Tabelle lesen und in Bauteil / Baugruppe erstellen
'*********************************************************************

Nummer_Eigenschaft = 0
Erzeugte_Eigenschaft = 0

Dim iCount As Integer
iCount = 1

'Für die Haupt-Baugruppe
If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Or ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then

For i = 1 To Anzahl_Eigenschaften
ZeilenNr = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "=", i)
Eigenschaftenname = GoExcel.CurrentRowValue("C")
Wert = GoExcel.CurrentRowValue("Name")
Datentyp = GoExcel.CurrentRowValue("Einheiten")
Typ = GoExcel.CurrentRowValue("Typ")
Beschreibung = GoExcel.CurrentRowValue("Beschreibung")

If Typ = "Eigenschaft" Then
Zähler_Eigenschaft = iPropertieCheck("", "Custom", Eigenschaftenname, "ND") 'Aufruf der Funktion "iPropertieCheck"
Erzeugte_Eigenschaft = Erzeugte_Eigenschaft + Zähler_Eigenschaft
Nummer_Eigenschaft = Nummer_Eigenschaft + 1
End If
Next

End If

'Für jedes Bauteil und jede Unterbaugruppe in der Haupt-Baugruppe
If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
Dim oApp As Inventor.Application = ThisApplication
Dim oAssyDoc As Inventor.AssemblyDocument = oApp.ActiveDocument

For Each oSubDoc As Inventor.Document In oAssyDoc.AllReferencedDocuments

    If oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kPartDocumentObject Or oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kAssemblyDocumentObject Then

Try
'Wenn das Bauteil ein Inhaltcenter-Bauteil ist, dann überspringe das Bauteil
oCustomPropertySet = oSubDoc.PropertySets.Item("2DB9508F-CBA8-4714-ABE9-1A0EDB5B586C") 'ContentCenter in VBA
Exit Try
Catch
'Wenn es sich um ein iPart oder ein iAssembly handelt, dann überspringe das Bauteil
If oSubDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
Dim oPartDoc As PartDocument = DirectCast(oSubDoc,PartDocument)
If oPartDoc.ComponentDefinition.IsContentMember = True Then Continue For
If oPartDoc.ComponentDefinition.IsiPartMember = True Then Continue For
If oPartDoc.ComponentDefinition.IsiPartFactory = True Then Continue For
If oPartDoc.IsModifiable = False Then Continue For
End If

If oSubDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
Dim oAssDoc As AssemblyDocument = DirectCast(oSubDoc,AssemblyDocument)
If oAssDoc.ComponentDefinition.IsiAssemblyMember= True Then Continue For
If oAssDoc.ComponentDefinition.IsiAssemblyFactory = True Then Continue For
If oAssDoc.IsModifiable = False Then Continue For
End If

'Wenn das Bauteil ein "normales" Bauteil ist, dann erstelle die Eigenschaften
oCustomPropertySet = oSubDoc.PropertySets.Item("D5CDD505-2E9C-101B-9397-08002B2CF9AE") 'benutzerdefinierte iProperties

For i = 1 To Anzahl_Eigenschaften
ZeilenNr = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "=", i)
Eigenschaftenname = GoExcel.CurrentRowValue("C")
Wert = GoExcel.CurrentRowValue("Name")
Datentyp = GoExcel.CurrentRowValue("Einheiten")
Typ = GoExcel.CurrentRowValue("Typ")
Beschreibung = GoExcel.CurrentRowValue("Beschreibung")

If Typ = "Eigenschaft" Then
'MsgBox("1. IF-Then: Eigenschaft - Spalte C" & vbCrLf & "Zeilennummer i: " & i)
Zähler_Eigenschaft = iPropertieCheck(GetDisplayName(oSubDoc),"Custom", Eigenschaftenname, "ND") 'Aufruf der Funktion "iPropertieCheck"
Erzeugte_Eigenschaft = Erzeugte_Eigenschaft + Zähler_Eigenschaft
Nummer_Eigenschaft = Nummer_Eigenschaft + 1
End If

If Typ = "Wert [Werteliste]" Then
'MsgBox("2. If-Then: Wert [Werteliste] - Spalte Name" & vbCrLf & "Zeilennummer i: " & i)
Zähler_Benutzerparameter = BenutzerParameterAnlegen(GetDisplayName(oSubDoc), i, Eigenschaftenname, Wert, Beschreibung, Eigenschaftentabelle) 'Aufruf der Funktion "BenutzerParameterAnlegen"
Erzeugter_Benutzerparameter = Erzeugter_Benutzerparameter + Zähler_Benutzerparameter
Nummer_Benutzerparameter = Nummer_Benutzerparameter + 1
End If
Next
End Try
    End If

iCount = iCount + 1
Next
End If

MessageBox.Show("Es wurden alle fehlenden iProperties in den verbauten Baugruppen und Bauteilen angelegt." & Chr(13) & Chr(13) _
& "Es wurden insgesamt " & Nummer_Eigenschaft & " eindeutige Eigenschaften gelesen." & Chr(13) & Chr(13) _
& "Es wurden in insgesamt " & iCount & " Bauteilen und Baugruppen die Eigenschaften erstellt." & Chr(13) & Chr(13) _
& "Es wurden in Summe " & Erzeugte_Eigenschaft & " neue Eigenschaften in den Bauteilen und Baugruppen angelegt." & Chr(13) _
& "Die restlichen Eigenschaften sind bereits vorhanden", "iPropertie", MessageBoxButtons.OK, MessageBoxIcon.Information)

End Sub

'########################################
'# Funktionen #
'########################################

'****************************************
'Funktion Prüfung iProperty und ergänzen
'****************************************

Private Function iPropertieCheck(Bauteilname As String, Reiter As String, Eigenschaft As String, Eigenschaftswert As String) As Integer
Try
iProp = iProperties.Value(Bauteilname, Reiter, Eigenschaft)
Catch
' MessageBox.Show("Das iPropertie """ & Eigenschaft & """ wurde nicht gefunden." & vbLf & vbLf & "Das iPropertie """ & Eigenschaft & """ wird in der Datei angelegt." _
' & vbLf & vbLf & "Der Inhalt des iPropertie ist: " & Eigenschaftswert, "iPropertie", MessageBoxButtons.OK, MessageBoxIcon.Information)

iProperties.Value(Bauteilname, Reiter, Eigenschaft) = Eigenschaftswert

Zähler_Eigenschaft = 1
Return Zähler_Eigenschaft
End Try
End Function

'****************************************
'Funktion Benutzerparameter als Text-Parameter mit Multiauswahlliste erstellen
'****************************************

Private Function BenutzerParameterAnlegen(Bauteilname As String, Zeile As Integer , Eigenschaft As String, Eigenschaftswert As String, Eigenschaftsbeschreibung As String, Tabellenname As String) As Integer
'Erstellen der Benutzerparameter
Dim Benutzerparameter As UserParameters
Benutzerparameter = ThisApplication.ActiveDocument.ComponentDefinition.Parameters.UserParameters
Benutzerparametername = "z_" & Eigenschaft
'MsgBox("Benutzerparametername: "  & Benutzerparametername)
Try
BenPara = Benutzerparameter.Item(Benutzerparametername)
'MsgBox("Benutzerparametername: " & Benutzerparametername & " ist vorhanden.")
Catch
' MessageBox.Show("Der Benutzerparameter """ & Benutzerparametername & """ wurde nicht gefunden." & vbLf & vbLf & "Der Benutzerparameter """ & Benutzerparametername & """ wird in der Datei angelegt." _
' & vbLf & vbLf & "Der Inhalt des Benutzerparameters ist: " & Eigenschaft, "Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)

BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits)
'MsgBox("Der Benutzerparametername: "  & Benutzerparametername & " wurde angelegt.")

Zähler_Benutzerparameter = 1
Return Zähler_Benutzerparameter
End Try

'Erstellen der Mulitiauswahlliste
' ZeilenNr_Eigenschaft = GoExcel.FindRow(Tabellenname, "Tunnelbau", "Nummer", "=", Zeile)
' Eigenschaftenname = GoExcel.CurrentRowValue("C")

' MsgBox("Erstellung der Multiauswahlliste:" & vbCrLf & "Zeilennummer i: " & Zeile & Chr(13) & "ZeilenNr_Eigenschaft: " & ZeilenNr_Eigenschaft & vbCrLf & "Eigenschaftsbeschreibung: " & Eigenschaftsbeschreibung & Chr(13) & "Eigenschaft: " & "z_" & Eigenschaftenname)

Dim Liste As New ArrayList
Liste = MultiValue.List(Benutzerparametername)
If Eigenschaftsbeschreibung = "" Then
Eigenschaftsbeschreibung = "-"
End If
Liste.Add(Eigenschaftsbeschreibung)
MultiValue.List(Benutzerparametername) = Liste

'Ausgabedialog zur Kontrolle - kann auskommentiert werden!
' MsgBox("Es wurde folgender Benutzerparameter mit einer Auswahlliste befüllt: " & Chr(13) & Benutzerparametername & Chr(13) & _
'   "Der Benutzerparameter enthält derzeit den Wert: " & Chr(13) & Parameter(Benutzerparametername))

Zähler_Benutzerparameter = 1
Return Zähler_Benutzerparameter

End Function

'****************************************
'Funktion Abfrage Anzeigename von Teilen
'****************************************
Private Function GetDisplayName(oTeil As Inventor.Document) As String
If oTeil.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
Return GetDisplayName(DirectCast(oTeil,Inventor.PartDocument))
Else
Return GetDisplayName(DirectCast(oTeil,Inventor.AssemblyDocument))
End If
End Function

'****************************************
'Funktion Abfrage Anzeigename von Bauteilen
'****************************************
Private Function GetDisplayName(oBauteil As Inventor.PartDocument) As String
If oBauteil.ComponentDefinition.IsModelStateMember = True Then
oBauteil = DirectCast(oBauteil.ComponentDefinition.FactoryDocument,Inventor.PartDocument)
End If
Return oBauteil.DisplayName
End Function

'****************************************
'Funktion Abfrage Anzeigename von Baugruppen
'****************************************
Private Function GetDisplayName(oBaugruppe As Inventor.AssemblyDocument) As String
If oBaugruppe.ComponentDefinition.IsModelStateMember = True Then
oBaugruppe = DirectCast(oBaugruppe.ComponentDefinition.FactoryDocument,Inventor.AssemblyDocument)
End If
Return oBaugruppe.DisplayName
End Function

---

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

---

Moin

Ich kann es mir erst später genauer ansehen, aber

Code:

---

Dim Benutzerparameter As UserParameters
Benutzerparameter = ThisApplication.ActiveDocument.ComponentDefinition.Parameters.UserParameters

---

nimmt immer wieder die Benutzerparameter des aktiven Dokumentes und das ist deine Hauptbaugruppe. Als Eselsbrücke, das aktive Dokument ist immer das Dokument, dass in der Titelleiste des Inventorfensters ganz oben angezeigt wird.

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

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

---

Moin

Ändere bitte den Aufruf der Funktion in :

Code:

---

Zähler_Benutzerparameter = BenutzerParameterAnlegen(oSubDoc, i, Eigenschaftenname, Wert, Beschreibung, Eigenschaftentabelle) 'Aufruf der Funktion "BenutzerParameterAnlegen"

---

und den Beginn der Funktion in:

Code:

---

Private Function BenutzerParameterAnlegen(oDoc As Document, Zeile As Integer , Eigenschaft As String, Eigenschaftswert As String, Eigenschaftsbeschreibung As String, Tabellenname As String) As Integer
'Erstellen der Benutzerparameter
Dim Benutzerparameter As UserParameters
Benutzerparameter = oDoc.ComponentDefinition.Parameters.UserParameters

---

Ich kann es aus Zeitgründen nicht testen. Hoffe es passt so.

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

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

---

Hallo Ralf,

vielen, vielen Dank für Deine Zeit und Unterstützung. Ich weiß es sehr zu schätzen.
Danke für die Änderungen. Damit funktioniert es - fast.
Es werden nun in allen Unterbaugruppen und allen Bauteilen die Benutzerparameter angelegt.
Aber es fehlen nun noch die Multi-Auswahllisten in den Unterbaugruppen und Bauteilen zu den Benutzerparametern. Die werden nur in der Hauptbaugruppe angelegt.
Ich habe allerdings für die Hauptbaugruppe nochmals einen separaten Funtionsaufruf eingefügt, so wie es auch schon für die iProperties erfolgte.

Ich dachte mir, dass ich in der Funktion auch noch das oDoc vor die MultiValue-Anweisung setzen muss, damit das entsprechende Bauteil angesprochen wird. Doch das führt zu Fehlermeldungen:

System.MissingMemberException: Public member 'MultiValue' on type 'AssemblyDocument' not found.
  bei Microsoft.VisualBasic.CompilerServices.LateBinding.LateGet(Object o, Type objType, String name, Object[] args, String[] paramnames, Boolean[] CopyBack)
  bei Microsoft.VisualBasic.CompilerServices.NewLateBinding.LateGet(Object Instance, Type Type, String MemberName, Object[] Arguments, String[] ArgumentNames, Type[] TypeArguments, Boolean[] CopyBack)
  bei ThisRule.BenutzerParameterAnlegen(Document oDoc, Int32 Zeile, String Eigenschaft, String Eigenschaftswert, String Eigenschaftsbeschreibung, String Tabellenname) in Externe Regel: z_Pfaffensteig-Eigenschaften_in_Baugruppen_und_Bauteilen_V4:Zeile 229
  bei ThisRule.Main() in Externe Regel: z_Pfaffensteig-Eigenschaften_in_Baugruppen_und_Bauteilen_V4:Zeile 97
  bei Autodesk.iLogic.Exec.AppDomExec.ExecRuleInAssembly(Assembly assem)
  bei Autodesk.iLogic.Exec.AppDomExec.ExecCodeHere()
  bei Autodesk.iLogic.Exec.AppDomExec.ExecCodeInOtherDomain(AppDomain otherDomain, String assemName)
  bei iLogic.RuleEvalContainer.ExecRuleEval(String execRule)

Das ist der Code, mit oDoc. Die Zeile 229 habe ich fett hervorgehoben.

Code:

---

Private Function BenutzerParameterAnlegen(oDoc As Document, Zeile As Integer , Eigenschaft As String, Eigenschaftswert As String, Eigenschaftsbeschreibung As String, Tabellenname As String) As Integer
'Erstellen der Benutzerparameter
Dim Benutzerparameter As UserParameters
Benutzerparameter = oDoc.ComponentDefinition.Parameters.UserParameters
Benutzerparametername = "z_" & Eigenschaft
'MsgBox("Benutzerparametername: "  & Benutzerparametername)
Try
BenPara = Benutzerparameter.Item(Benutzerparametername)
'MsgBox("Benutzerparametername: " & Benutzerparametername & " ist vorhanden.")
Catch
' MessageBox.Show("Der Benutzerparameter """ & Benutzerparametername & """ wurde nicht gefunden." & vbLf & vbLf & "Der Benutzerparameter """ & Benutzerparametername & """ wird in der Datei angelegt." _
' & vbLf & vbLf & "Der Inhalt des Benutzerparameters ist: " & Eigenschaft, "Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)

BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits)
'MsgBox("Der Benutzerparametername: "  & Benutzerparametername & " wurde angelegt.")

Zähler_Benutzerparameter = 1
Return Zähler_Benutzerparameter
End Try

'Erstellen der Mulitiauswahlliste
' MsgBox("Erstellung der Multiauswahlliste:" & vbCrLf & "Zeilennummer i: " & Zeile & Chr(13) & "ZeilenNr_Eigenschaft: " & ZeilenNr_Eigenschaft & vbCrLf & "Eigenschaftsbeschreibung: " & Eigenschaftsbeschreibung & Chr(13) & "Eigenschaft: " & "z_" & Eigenschaftenname)

Dim Liste As New ArrayList

Liste = oDoc.MultiValue.List(Benutzerparametername)

If Eigenschaftsbeschreibung = "" Then
Eigenschaftsbeschreibung = "-"
End If
oDoc.Liste.Add(Eigenschaftsbeschreibung)
oDoc.MultiValue.List(Benutzerparametername) = Liste

'Ausgabedialog zur Kontrolle - kann auskommentiert werden!
' MsgBox("Es wurde folgender Benutzerparameter mit einer Auswahlliste befüllt: " & Chr(13) & Benutzerparametername & Chr(13) & _
'   "Der Benutzerparameter enthält derzeit den Wert: " & Chr(13) & Parameter(Benutzerparametername))

Zähler_Benutzerparameter = 1
Return Zähler_Benutzerparameter

End Function

---

Hier nochmals mein gesamter Code:

Code:

---

'******************************************************************************************************************************
' Diese Programm erzeugt in Bauteilen (*.ipt) und/oder Baugruppen (*.iam) benutzerdefinierte Eigenschaften, die aus einer
' Exceltabelle eingelesen werden. Das Programm erzeugt die Eigenschaften in Baugruppen, Unterbaugruppen und den einzelnen
' Bauteilen in den Baugruppen und Unterbaugruppen.
' Buteilvarianten von iParts oder Baugruppenvarianten von iAssemblies werden ausgelassen, da von diesen die iProperties nicht
' geändert werden können
'
' Das Programm ist dazu gedacht, die im Projekt Pfaffensteigtunnel definierten Eigenschaften als benutzerdefinierte iProperties
' in den Baugruppen und Bauteilen anzulegen, damit diese für die BIM-Prozesse verwendet werden können.
'******************************************************************************************************************************

Sub Main()

Dim i As Integer
Dim Nummer_Eigenschaft As Integer

'********************************************************************
'Prüfung, ob ein Bauteil oder eine Baugruppe geöffnet und aktiv ist
'********************************************************************
If Not ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject And Not ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
MessageBox.Show("Die aktive Datei ist kein Beuteil oder keine Baugruppe!" & Chr(13) & Chr(13) & "Ein Bauteil (*.ipt) oder eine Baugruppe (*.iam) muss geöffnet bzw. aktiv sein.", "Inventor")
Exit Sub
End If

'**********************************************************************************************************
'Dateiauswahl für Exceltabelle mit benutzerdefinierten Projekt-Eigenschaften für Bauteile oder Baugruppen
'**********************************************************************************************************
Dim oFileDlg_Tabelle As Inventor.FileDialog = Nothing
ThisApplication.CreateFileDialog(oFileDlg_Tabelle)

Try
'oFileDlg_Tabelle.Filter = "XML Files (*.xml)|*.xml"
oFileDlg_Tabelle.Filter = "Excel Files (*.xls;*.xlsx;*.xlsm)|*.xls;*.xlsx;*.xlsm"
'oFileDlg_Tabelle.Filter = "Text Files (*.txt;*.csv)|*.txt;*.csv"
oFileDlg_Tabelle.DialogTitle = "Auswahl Excel-Tabelle mit projektspezifischen Eigenschaften Pfaffensteigtunnel aus BIMQ"
oFileDlg_Tabelle.InitialDirectory = ThisDoc.Path
oFileDlg_Tabelle.CancelError = True
oFileDlg_Tabelle.ShowOpen()

If oFileDlg_Tabelle.FileName <> "" Then
Eigenschaftentabelle = oFileDlg_Tabelle.FileName
'MessageBox.Show("Es wurde die folgende Datei mit Eigenschaften ausgewählt:" & Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Auswahl getätigt")
End If

Catch
MessageBox.Show("Keine Datei ausgewählt. Das Programm wird beendet.", "Dialog Abbruch")
Exit Sub
End Try

'***********************************
'Anzahl Zeilen in Tabelle ermitteln
'***********************************

GoExcel.TitleRow = 2
GoExcel.FindRowStart = 3

Dim Zeilen_Tabelle As Integer
Dim Anzahl_Eigenschaften As Integer

Zeilen_Tabelle = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "<=", 50000)
Anzahl_Eigenschaften = Zeilen_Tabelle - 2
MessageBox.Show("In der ausgewählten Tabelle ist folgende Anzahl an Zeilen enthalten:" & Chr(13) & _
Anzahl_Eigenschaften & Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Anzahl Zeilen", MessageBoxButtons.OK, MessageBoxIcon.Information)

'*********************************************************************
'Eigenschaften aus Tabelle lesen und in Bauteil / Baugruppe erstellen
'*********************************************************************

Nummer_Eigenschaft = 0
Erzeugte_Eigenschaft = 0

Dim iCount As Integer
iCount = 1

'Für die Haupt-Baugruppe
If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Or ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then

For i = 1 To Anzahl_Eigenschaften
ZeilenNr = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "=", i)
Eigenschaftenname = GoExcel.CurrentRowValue("C")
Wert = GoExcel.CurrentRowValue("Name")
Datentyp = GoExcel.CurrentRowValue("Einheiten")
Typ = GoExcel.CurrentRowValue("Typ")
Beschreibung = GoExcel.CurrentRowValue("Beschreibung")

If Typ = "Eigenschaft" Then
Zähler_Eigenschaft = iPropertieCheck("", "Custom", Eigenschaftenname, "ND") 'Aufruf der Funktion "iPropertieCheck"
Erzeugte_Eigenschaft = Erzeugte_Eigenschaft + Zähler_Eigenschaft
Nummer_Eigenschaft = Nummer_Eigenschaft + 1
End If

If Typ = "Wert [Werteliste]" Then
'MsgBox("2. If-Then: Wert [Werteliste] - Spalte Name" & vbCrLf & "Zeilennummer i: " & i)
Zähler_Benutzerparameter = BenutzerParameterAnlegen(ThisApplication.ActiveDocument, i, Eigenschaftenname, Wert, Beschreibung, Eigenschaftentabelle) 'Aufruf der Funktion "BenutzerParameterAnlegen"
Erzeugter_Benutzerparameter = Erzeugter_Benutzerparameter + Zähler_Benutzerparameter
Nummer_Benutzerparameter = Nummer_Benutzerparameter + 1
End If
Next

End If

'Für jedes Bauteil und jede Unterbaugruppe in der Haupt-Baugruppe
If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
Dim oApp As Inventor.Application = ThisApplication
Dim oAssyDoc As Inventor.AssemblyDocument = oApp.ActiveDocument

For Each oSubDoc As Inventor.Document In oAssyDoc.AllReferencedDocuments

    If oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kPartDocumentObject Or oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kAssemblyDocumentObject Then

Try
'Wenn das Bauteil ein Inhaltcenter-Bauteil ist, dann überspringe das Bauteil
oCustomPropertySet = oSubDoc.PropertySets.Item("2DB9508F-CBA8-4714-ABE9-1A0EDB5B586C") 'ContentCenter in VBA
Exit Try
Catch
'Wenn es sich um ein iPart oder ein iAssembly handelt, dann überspringe das Bauteil
If oSubDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
Dim oPartDoc As PartDocument = DirectCast(oSubDoc,PartDocument)
If oPartDoc.ComponentDefinition.IsContentMember = True Then Continue For
If oPartDoc.ComponentDefinition.IsiPartMember = True Then Continue For
If oPartDoc.ComponentDefinition.IsiPartFactory = True Then Continue For
If oPartDoc.IsModifiable = False Then Continue For
End If

If oSubDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
Dim oAssDoc As AssemblyDocument = DirectCast(oSubDoc,AssemblyDocument)
If oAssDoc.ComponentDefinition.IsiAssemblyMember= True Then Continue For
If oAssDoc.ComponentDefinition.IsiAssemblyFactory = True Then Continue For
If oAssDoc.IsModifiable = False Then Continue For
End If

'Wenn das Bauteil ein "normales" Bauteil ist, dann erstelle die Eigenschaften
oCustomPropertySet = oSubDoc.PropertySets.Item("D5CDD505-2E9C-101B-9397-08002B2CF9AE") 'benutzerdefinierte iProperties

For i = 1 To Anzahl_Eigenschaften
ZeilenNr = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "=", i)
Eigenschaftenname = GoExcel.CurrentRowValue("C")
Wert = GoExcel.CurrentRowValue("Name")
Datentyp = GoExcel.CurrentRowValue("Einheiten")
Typ = GoExcel.CurrentRowValue("Typ")
Beschreibung = GoExcel.CurrentRowValue("Beschreibung")

If Typ = "Eigenschaft" Then
'MsgBox("1. IF-Then: Eigenschaft - Spalte C" & vbCrLf & "Zeilennummer i: " & i)
Zähler_Eigenschaft = iPropertieCheck(GetDisplayName(oSubDoc),"Custom", Eigenschaftenname, "ND") 'Aufruf der Funktion "iPropertieCheck"
Erzeugte_Eigenschaft = Erzeugte_Eigenschaft + Zähler_Eigenschaft
Nummer_Eigenschaft = Nummer_Eigenschaft + 1
End If

If Typ = "Wert [Werteliste]" Then
'MsgBox("2. If-Then: Wert [Werteliste] - Spalte Name" & vbCrLf & "Zeilennummer i: " & i)
Zähler_Benutzerparameter = BenutzerParameterAnlegen(oSubDoc, i, Eigenschaftenname, Wert, Beschreibung, Eigenschaftentabelle) 'Aufruf der Funktion "BenutzerParameterAnlegen"
Erzeugter_Benutzerparameter = Erzeugter_Benutzerparameter + Zähler_Benutzerparameter
Nummer_Benutzerparameter = Nummer_Benutzerparameter + 1
End If
Next
End Try
    End If

iCount = iCount + 1
Next
End If

MessageBox.Show("Es wurden alle fehlenden iProperties in den verbauten Baugruppen und Bauteilen angelegt." & Chr(13) & Chr(13) _
& "Es wurden insgesamt " & Nummer_Eigenschaft & " eindeutige Eigenschaften gelesen." & Chr(13) & Chr(13) _
& "Es wurden in insgesamt " & iCount & " Bauteilen und Baugruppen die Eigenschaften erstellt." & Chr(13) & Chr(13) _
& "Es wurden in Summe " & Erzeugte_Eigenschaft & " neue Eigenschaften in den Bauteilen und Baugruppen angelegt." & Chr(13) _
& "Die restlichen Eigenschaften sind bereits vorhanden", "iPropertie", MessageBoxButtons.OK, MessageBoxIcon.Information)

End Sub

'########################################
'# Funktionen #
'########################################

'****************************************
'Funktion Prüfung iProperty und ergänzen
'****************************************

Private Function iPropertieCheck(Bauteilname As String, Reiter As String, Eigenschaft As String, Eigenschaftswert As String) As Integer
Try
iProp = iProperties.Value(Bauteilname, Reiter, Eigenschaft)
Catch
' MessageBox.Show("Das iPropertie """ & Eigenschaft & """ wurde nicht gefunden." & vbLf & vbLf & "Das iPropertie """ & Eigenschaft & """ wird in der Datei angelegt." _
' & vbLf & vbLf & "Der Inhalt des iPropertie ist: " & Eigenschaftswert, "iPropertie", MessageBoxButtons.OK, MessageBoxIcon.Information)

iProperties.Value(Bauteilname, Reiter, Eigenschaft) = Eigenschaftswert

Zähler_Eigenschaft = 1
Return Zähler_Eigenschaft
End Try
End Function

'****************************************
'Funktion Benutzerparameter als Text-Parameter mit Multiauswahlliste erstellen
'****************************************

Private Function BenutzerParameterAnlegen(oDoc As Document, Zeile As Integer , Eigenschaft As String, Eigenschaftswert As String, Eigenschaftsbeschreibung As String, Tabellenname As String) As Integer
'Erstellen der Benutzerparameter
Dim Benutzerparameter As UserParameters
Benutzerparameter = oDoc.ComponentDefinition.Parameters.UserParameters
Benutzerparametername = "z_" & Eigenschaft
'MsgBox("Benutzerparametername: "  & Benutzerparametername)
Try
BenPara = Benutzerparameter.Item(Benutzerparametername)
'MsgBox("Benutzerparametername: " & Benutzerparametername & " ist vorhanden.")
Catch
' MessageBox.Show("Der Benutzerparameter """ & Benutzerparametername & """ wurde nicht gefunden." & vbLf & vbLf & "Der Benutzerparameter """ & Benutzerparametername & """ wird in der Datei angelegt." _
' & vbLf & vbLf & "Der Inhalt des Benutzerparameters ist: " & Eigenschaft, "Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)

BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits)
'MsgBox("Der Benutzerparametername: "  & Benutzerparametername & " wurde angelegt.")

Zähler_Benutzerparameter = 1
Return Zähler_Benutzerparameter
End Try

'Erstellen der Mulitiauswahlliste
' MsgBox("Erstellung der Multiauswahlliste:" & vbCrLf & "Zeilennummer i: " & Zeile & Chr(13) & "ZeilenNr_Eigenschaft: " & ZeilenNr_Eigenschaft & vbCrLf & "Eigenschaftsbeschreibung: " & Eigenschaftsbeschreibung & Chr(13) & "Eigenschaft: " & "z_" & Eigenschaftenname)

Dim Liste As New ArrayList
Liste = oDoc.MultiValue.List(Benutzerparametername)
If Eigenschaftsbeschreibung = "" Then
Eigenschaftsbeschreibung = "-"
End If
oDoc.Liste.Add(Eigenschaftsbeschreibung)
oDoc.MultiValue.List(Benutzerparametername) = Liste

'Ausgabedialog zur Kontrolle - kann auskommentiert werden!
' MsgBox("Es wurde folgender Benutzerparameter mit einer Auswahlliste befüllt: " & Chr(13) & Benutzerparametername & Chr(13) & _
'   "Der Benutzerparameter enthält derzeit den Wert: " & Chr(13) & Parameter(Benutzerparametername))

Zähler_Benutzerparameter = 1
Return Zähler_Benutzerparameter

End Function

'****************************************
'Funktion Abfrage Anzeigename von Teilen
'****************************************
Private Function GetDisplayName(oTeil As Inventor.Document) As String
If oTeil.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
Return GetDisplayName(DirectCast(oTeil,Inventor.PartDocument))
Else
Return GetDisplayName(DirectCast(oTeil,Inventor.AssemblyDocument))
End If
End Function

'****************************************
'Funktion Abfrage Anzeigename von Bauteilen
'****************************************
Private Function GetDisplayName(oBauteil As Inventor.PartDocument) As String
If oBauteil.ComponentDefinition.IsModelStateMember = True Then
oBauteil = DirectCast(oBauteil.ComponentDefinition.FactoryDocument,Inventor.PartDocument)
End If
Return oBauteil.DisplayName
End Function

'****************************************
'Funktion Abfrage Anzeigename von Baugruppen
'****************************************
Private Function GetDisplayName(oBaugruppe As Inventor.AssemblyDocument) As String
If oBaugruppe.ComponentDefinition.IsModelStateMember = True Then
oBaugruppe = DirectCast(oBaugruppe.ComponentDefinition.FactoryDocument,Inventor.AssemblyDocument)
End If
Return oBaugruppe.DisplayName
End Function

---

Kannst Du bitte nochmals einen Blick darauf werfen?
Danke.

Gruß Stephan

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

---

Moin

Ich hab es mal angepasst, so das es laufen sollte. Sollen die Multivalue Listen einen Wert selektiert haben? Bisher werden nur die Parameter und die Liste erstellt. Schaut man in den fx-Parameterdialog sieht man, dass da überall nichts ausgewählt wurde. Um beispielsweise immer den ersten Wert der Liste zu selektieren, kann man

Code:

---

MultiValue.SetValueOptions(True, DefaultIndex :=0)

---

einfügen. Der Index zählt von 0 hoch und muss in er Liste existieren. Das heißt, es darf kein Index verwendet werden der höher ist als die Liste lang. Ich hab die Zeile im Code stehe, aber erstmal auskommentiert.

Code:

---

''**iLogic system code start**
''**iLogic system code end**

'******************************************************************************************************************************
' Diese Programm erzeugt in Bauteilen (*.ipt) und/oder Baugruppen (*.iam) benutzerdefinierte Eigenschaften, die aus einer
' Exceltabelle eingelesen werden. Das Programm erzeugt die Eigenschaften in Baugruppen, Unterbaugruppen und den einzelnen
' Bauteilen in den Baugruppen und Unterbaugruppen.
' Buteilvarianten von iParts oder Baugruppenvarianten von iAssemblies werden ausgelassen, da von diesen die iProperties nicht
' geändert werden können
'
' Das Programm ist dazu gedacht, die im Projekt Pfaffensteigtunnel definierten Eigenschaften als benutzerdefinierte iProperties
' in den Baugruppen und Bauteilen anzulegen, damit diese für die BIM-Prozesse verwendet werden können.
'******************************************************************************************************************************

Public Sub Main() Implements IRuleInterface.Main ''**iLogic system**

Dim i As Integer
Dim Nummer_Eigenschaft As Integer

break

'********************************************************************
'Prüfung, ob ein Bauteil oder eine Baugruppe geöffnet und aktiv ist
'********************************************************************
If Not ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject And Not ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
MessageBox.Show("Die aktive Datei ist kein Beuteil oder keine Baugruppe!" & Chr(13) & Chr(13) & "Ein Bauteil (*.ipt) oder eine Baugruppe (*.iam) muss geöffnet bzw. aktiv sein.", "Inventor")
Exit Sub
End If

'**********************************************************************************************************
'Dateiauswahl für Exceltabelle mit benutzerdefinierten Projekt-Eigenschaften für Bauteile oder Baugruppen
'**********************************************************************************************************
Dim oFileDlg_Tabelle As Inventor.FileDialog = Nothing
ThisApplication.CreateFileDialog(oFileDlg_Tabelle)

Try
'oFileDlg_Tabelle.Filter = "XML Files (*.xml)|*.xml"
oFileDlg_Tabelle.Filter = "Excel Files (*.xls;*.xlsx;*.xlsm)|*.xls;*.xlsx;*.xlsm"
'oFileDlg_Tabelle.Filter = "Text Files (*.txt;*.csv)|*.txt;*.csv"
oFileDlg_Tabelle.DialogTitle = "Auswahl Excel-Tabelle mit projektspezifischen Eigenschaften Pfaffensteigtunnel aus BIMQ"
oFileDlg_Tabelle.InitialDirectory = ThisDoc.Path
oFileDlg_Tabelle.CancelError = True
oFileDlg_Tabelle.ShowOpen()

If oFileDlg_Tabelle.FileName <> "" Then
Eigenschaftentabelle = oFileDlg_Tabelle.FileName
'MessageBox.Show("Es wurde die folgende Datei mit Eigenschaften ausgewählt:" & Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Auswahl getätigt")
End If

Catch
MessageBox.Show("Keine Datei ausgewählt. Das Programm wird beendet.", "Dialog Abbruch")
Exit Sub
End Try

'***********************************
'Anzahl Zeilen in Tabelle ermitteln
'***********************************

GoExcel.TitleRow = 2
GoExcel.FindRowStart = 3

Dim Zeilen_Tabelle As Integer
Dim Anzahl_Eigenschaften As Integer

Zeilen_Tabelle = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "<=", 50000)
Anzahl_Eigenschaften = Zeilen_Tabelle - 2
MessageBox.Show("In der ausgewählten Tabelle ist folgende Anzahl an Zeilen enthalten:" & Chr(13) & _
Anzahl_Eigenschaften & Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Anzahl Zeilen", MessageBoxButtons.OK, MessageBoxIcon.Information)

'*********************************************************************
'Eigenschaften aus Tabelle lesen und in Bauteil / Baugruppe erstellen
'*********************************************************************

Nummer_Eigenschaft = 0
Erzeugte_Eigenschaft = 0

Dim iCount As Integer
iCount = 1

'Für die Haupt-Baugruppe
If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Or ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then

For i = 1 To Anzahl_Eigenschaften
ZeilenNr = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "=", i)
Eigenschaftenname = GoExcel.CurrentRowValue("C")
Wert = GoExcel.CurrentRowValue("Name")
Datentyp = GoExcel.CurrentRowValue("Einheiten")
Typ = GoExcel.CurrentRowValue("Typ")
Beschreibung = GoExcel.CurrentRowValue("Beschreibung")

If Typ = "Eigenschaft" Then
Zähler_Eigenschaft = iPropertieCheck("", "Custom", Eigenschaftenname, "ND")
Erzeugte_Eigenschaft = Erzeugte_Eigenschaft + Zähler_Eigenschaft
Nummer_Eigenschaft = Nummer_Eigenschaft + 1
End If

If Typ = "Wert [Werteliste]" Then
'MsgBox("2. If-Then: Wert [Werteliste] - Spalte Name" & vbCrLf & "Zeilennummer i: " & i)
Zähler_Benutzerparameter = BenutzerParameterAnlegen(ThisApplication.ActiveDocument,  i, Eigenschaftenname, Wert, Beschreibung, Eigenschaftentabelle)
Erzeugter_Benutzerparameter = Erzeugter_Benutzerparameter + Zähler_Benutzerparameter
Nummer_Benutzerparameter = Nummer_Benutzerparameter + 1
End If
Next

End If

'Für jedes Bauteil und jede Unterbaugruppe in der Haupt-Baugruppe
If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
Dim oApp As Inventor.Application = ThisApplication
Dim oAssyDoc As Inventor.AssemblyDocument = oApp.ActiveDocument

For Each oSubDoc As Inventor.Document In oAssyDoc.AllReferencedDocuments

    If oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kPartDocumentObject Or oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kAssemblyDocumentObject Then

Try
'Wenn das Bauteil ein Inhaltcenter-Bauteil ist, dann überspringe das Bauteil
oCustomPropertySet = oSubDoc.PropertySets.Item("2DB9508F-CBA8-4714-ABE9-1A0EDB5B586C")
Exit Try
Catch
'Wenn es sich um ein iPart oder ein iAssembly handelt, dann überspringe das Bauteil
If oSubDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
Dim oPartDoc As PartDocument = DirectCast(oSubDoc,PartDocument)
If oPartDoc.ComponentDefinition.IsContentMember = True Then Continue For
If oPartDoc.ComponentDefinition.IsiPartMember = True Then Continue For
If oPartDoc.ComponentDefinition.IsiPartFactory = True Then Continue For
If oPartDoc.IsModifiable = False Then Continue For
End If

If oSubDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
Dim oAssDoc As AssemblyDocument = DirectCast(oSubDoc,AssemblyDocument)
If oAssDoc.ComponentDefinition.IsiAssemblyMember= True Then Continue For
If oAssDoc.ComponentDefinition.IsiAssemblyFactory = True Then Continue For
If oAssDoc.IsModifiable = False Then Continue For
End If

'Wenn das Bauteil ein "normales" Bauteil ist, dann erstelle die Eigenschaften
oCustomPropertySet = oSubDoc.PropertySets.Item("D5CDD505-2E9C-101B-9397-08002B2CF9AE")

For i = 1 To Anzahl_Eigenschaften
ZeilenNr = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "=", i)
Eigenschaftenname = GoExcel.CurrentRowValue("C")
Wert = GoExcel.CurrentRowValue("Name")
Datentyp = GoExcel.CurrentRowValue("Einheiten")
Typ = GoExcel.CurrentRowValue("Typ")
Beschreibung = GoExcel.CurrentRowValue("Beschreibung")

If Typ = "Eigenschaft" Then
'MsgBox("1. IF-Then: Eigenschaft - Spalte C" & vbCrLf & "Zeilennummer i: " & i)
Zähler_Eigenschaft = iPropertieCheck(GetDisplayName(oSubDoc),"Custom", Eigenschaftenname, "ND")
Erzeugte_Eigenschaft = Erzeugte_Eigenschaft + Zähler_Eigenschaft
Nummer_Eigenschaft = Nummer_Eigenschaft + 1
End If

If Typ = "Wert [Werteliste]" Then
'MsgBox("2. If-Then: Wert [Werteliste] - Spalte Name" & vbCrLf & "Zeilennummer i: " & i)
Zähler_Benutzerparameter = BenutzerParameterAnlegen(oSubDoc, i, Eigenschaftenname, Wert, Beschreibung, Eigenschaftentabelle, GetDisplayName(oSubDoc))
Erzeugter_Benutzerparameter = Erzeugter_Benutzerparameter + Zähler_Benutzerparameter
Nummer_Benutzerparameter = Nummer_Benutzerparameter + 1
End If
Next
End Try
    End If

iCount = iCount + 1
Next
End If

MessageBox.Show("Es wurden alle fehlenden iProperties in den verbauten Baugruppen und Bauteilen angelegt." & Chr(13) & Chr(13) _
& "Es wurden insgesamt " & Nummer_Eigenschaft & " eindeutige Eigenschaften gelesen." & Chr(13) & Chr(13) _
& "Es wurden in insgesamt " & iCount & " Bauteilen und Baugruppen die Eigenschaften erstellt." & Chr(13) & Chr(13) _
& "Es wurden in Summe " & Erzeugte_Eigenschaft & " neue Eigenschaften in den Bauteilen und Baugruppen angelegt." & Chr(13) _
& "Die restlichen Eigenschaften sind bereits vorhanden", "iPropertie", MessageBoxButtons.OK, MessageBoxIcon.Information)

End Sub

'########################################
'# Funktionen #
'########################################

'****************************************
'Funktion Prüfung iProperty und ergänzen
'****************************************

Private Function iPropertieCheck(Bauteilname As String, Reiter As String, Eigenschaft As String, Eigenschaftswert As String) As Integer
Try
iProp = iProperties.Value(Bauteilname, Reiter, Eigenschaft)
Catch
' MessageBox.Show("Das iPropertie """ & Eigenschaft & """ wurde nicht gefunden." & vbLf & vbLf & "Das iPropertie """ & Eigenschaft & """ wird in der Datei angelegt." _
' & vbLf & vbLf & "Der Inhalt des iPropertie ist: " & Eigenschaftswert, "iPropertie", MessageBoxButtons.OK, MessageBoxIcon.Information)

iProperties.Value(Bauteilname, Reiter, Eigenschaft) = Eigenschaftswert

Zähler_Eigenschaft = 1
Return Zähler_Eigenschaft
End Try
End Function

'****************************************
'Funktion Benutzerparameter als Text-Parameter mit Multiauswahlliste erstellen
'****************************************

Private Function BenutzerParameterAnlegen(oDoc As Document, Zeile As Integer , Eigenschaft As String, Eigenschaftswert As String, Eigenschaftsbeschreibung As String, Tabellenname As String , Optional Bauteilname As String = "") As Integer
'Erstellen der Benutzerparameter
Dim Benutzerparameter As UserParameters
Benutzerparameter = oDoc.ComponentDefinition.Parameters.UserParameters
Benutzerparametername = "z_" & Eigenschaft
'MsgBox("Benutzerparametername: "  & Benutzerparametername)
Try
BenPara = Benutzerparameter.Item(Benutzerparametername)
'MsgBox("Benutzerparametername: " & Benutzerparametername & " ist vorhanden.")
Catch
' MessageBox.Show("Der Benutzerparameter """ & Benutzerparametername & """ wurde nicht gefunden." & vbLf & vbLf & "Der Benutzerparameter """ & Benutzerparametername & """ wird in der Datei angelegt." _
' & vbLf & vbLf & "Der Inhalt des Benutzerparameters ist: " & Eigenschaft, "Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)

BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits)
'MsgBox("Der Benutzerparametername: "  & Benutzerparametername & " wurde angelegt.")

Zähler_Benutzerparameter = 1
Return Zähler_Benutzerparameter
End Try

'Erstellen der Mulitiauswahlliste
' MsgBox("Erstellung der Multiauswahlliste:" & vbCrLf & "Zeilennummer i: " & Zeile & Chr(13) & "ZeilenNr_Eigenschaft: " & ZeilenNr_Eigenschaft & vbCrLf & "Eigenschaftsbeschreibung: " & Eigenschaftsbeschreibung & Chr(13) & "Eigenschaft: " & "z_" & Eigenschaftenname)

' die Zeile aktivieren, damit beim Erzeugen/Ändern der Multivalueliste der in DefaultIndex definierte Wert ausgewählt wird.
' MultiValue.SetValueOptions(True, DefaultIndex :=0)

Dim Liste As New ArrayList
If Bauteilname="" Then
Liste = MultiValue.List(Benutzerparametername)
Else
Liste = MultiValue.List(Bauteilname, Benutzerparametername)
End If

If Eigenschaftsbeschreibung = "" Then
Eigenschaftsbeschreibung = "-"
End If
Liste.Add(Eigenschaftsbeschreibung)

If Bauteilname="" Then
MultiValue.List(Benutzerparametername) = Liste
Else
MultiValue.List(Bauteilname, Benutzerparametername) = Liste
End If

'Ausgabedialog zur Kontrolle - kann auskommentiert werden!
' MsgBox("Es wurde folgender Benutzerparameter mit einer Auswahlliste befüllt: " & Chr(13) & Benutzerparametername & Chr(13) & _
'  "Der Benutzerparameter enthält derzeit den Wert: " & Chr(13) & Parameter(Benutzerparametername))

Zähler_Benutzerparameter = 1
Return Zähler_Benutzerparameter

End Function

'****************************************
'Funktion Abfrage Anzeigename von Teilen
'****************************************
Private Function GetDisplayName(oTeil As Inventor.Document) As String
If oTeil.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
Return GetDisplayName(DirectCast(oTeil,Inventor.PartDocument))
Else
Return GetDisplayName(DirectCast(oTeil,Inventor.AssemblyDocument))
End If
End Function

'****************************************
'Funktion Abfrage Anzeigename von Bauteilen
'****************************************
Private Function GetDisplayName(oBauteil As Inventor.PartDocument) As String
If oBauteil.ComponentDefinition.IsModelStateMember = True Then
oBauteil = DirectCast(oBauteil.ComponentDefinition.FactoryDocument,Inventor.PartDocument)
End If
Return oBauteil.DisplayName
End Function

'****************************************
'Funktion Abfrage Anzeigename von Baugruppen
'****************************************
Private Function GetDisplayName(oBaugruppe As Inventor.AssemblyDocument) As String
If oBaugruppe.ComponentDefinition.IsModelStateMember = True Then
oBaugruppe = DirectCast(oBaugruppe.ComponentDefinition.FactoryDocument,Inventor.AssemblyDocument)
End If
Return oBaugruppe.DisplayName
End Function

---

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

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

---

Wurfel.zip

Hallo Ralf,

ich bin etwas am verzweifeln.
Ich bekomme es einfach nicht hin und sehe aber auch den Fehler nicht. Ich muss gestehen, ich bin nicht der ganz erfahrene Programmierer.

Der Code macht aus meiner Sicht etwas seltsame Dinge, die ich mir nicht erklären kann.
Ich habe einige Infoboxen in den Code eingefügt, um zu sehen, was genau passiert. Damit kann man die einzelnen Schritte etwas besser erkennen.

In der Schleife, in der die Funktion "BenutzerParameterAnlegen" aufgerufen wird, wird die Funktion manchmal nicht ausgeführt, obwohl die Bedingungen passen:

Code:

---

'Für die Haupt-Baugruppe
If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Or ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then

For i = 1 To Anzahl_Eigenschaften
' ZeilenNr = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "=", i)
' Eigenschaftenname = GoExcel.CurrentRowValue("C")
' Wert = GoExcel.CurrentRowValue("Name")
' Datentyp = GoExcel.CurrentRowValue("Einheiten")
' Typ = GoExcel.CurrentRowValue("Typ")
' Beschreibung = GoExcel.CurrentRowValue("Beschreibung")

Dim Zelle_Ci As String = "C" & i ' Spalte C: Eigenschaftsname
Dim Zelle_Di As String = "D" & i ' Spalte D: Eigenscahftswert
Dim Zelle_Ii As String = "I" & i ' Spalte I: Einheit der Eigenschaft
Dim Zelle_Fi As String = "F" & i ' Spalte F: Datentyp der Eigenschaft
Dim Zelle_Hi As String = "H" & i ' Spalte H: Beschreibungatext der Eigenschaft bzw. des Eigenschaftswerts

Eigenschaftenname = GoExcel.CellValue(Zelle_Ci)
Wert = GoExcel.CellValue(Zelle_Di)
Datentyp = GoExcel.CellValue(Zelle_Ii)
Typ = GoExcel.CellValue(Zelle_Fi)
Beschreibung = GoExcel.CellValue(Zelle_Hi)

If Typ = "Eigenschaft" Then
MsgBox("1. If-Then: Eigenschaft - Spalte Name:" & vbCrLf & "Zeilennummer i: " & i & vbCrLf & "Eigenschaftenname: " & Eigenschaftenname & vbCrLf & "Wert: " & Wert & vbCrLf & "Beschreibung: " & Beschreibung)
Zähler_Eigenschaft = iPropertieCheck("", "Custom", Eigenschaftenname, "ND") 'Aufruf der Funktion "iPropertieCheck"
Erzeugte_Eigenschaft = Erzeugte_Eigenschaft + Zähler_Eigenschaft
Nummer_Eigenschaft = Nummer_Eigenschaft + 1
End If

If Typ = "Wert [Werteliste]" Then
MsgBox("2. If-Then: Wert [Werteliste] - Spalte Name:" & vbCrLf & "Zeilennummer i: " & i & vbCrLf & "Eigenschaftenname :" & Eigenschaftenname & vbCrLf & "Wert :" & Wert & vbCrLf & "Beschreibung: " & Beschreibung)
Zähler_Benutzerparameter = BenutzerParameterAnlegen(ThisApplication.ActiveDocument, i, Eigenschaftenname, Wert, Beschreibung, Eigenschaftentabelle) 'Aufruf der Funktion "BenutzerParameterAnlegen"
Erzeugter_Benutzerparameter = Erzeugter_Benutzerparameter + Zähler_Benutzerparameter
Nummer_Benutzerparameter = Nummer_Benutzerparameter + 1
End If
Next

End If

---

Das führt dazu, dass die Auswahllisten in den Benutzerparameter nicht oder nicht vollständig (es fehlen ein paar Einträge) erstellt werden.
Lasse ich den Code ein zweites mal laufen, dann werden die im ersten Durchgang ausgelassenen Werte in den Auswahllisten und die Auswahllisten bei den restlichen Benutzerparameter ergänzt.
Ich verstehe nicht, warum die Funktion beim ertsen ausführen manchmal nicht aufgerufen oder nicht ausgeführt wird, wohl aber beim zweiten mal Ausführen.

Dann klappt das mit den Auswahllisten in den Unterbaugruppen und Bauteilen leider auch noch nicht.
Ich verstehe das "Optional" in der Funktion nicht. Was bewirkt das?

Code:

---

Private Function BenutzerParameterAnlegen(oDoc As Document, Zeile As Integer , Eigenschaft As String, Eigenschaftswert As String, Eigenschaftsbeschreibung As String, Tabellenname As String, Optional Bauteilname As String = "") As Integer

---

Müsste ich dann aber nicht auch im Funktionsaufruf diesen optionalen Bauteilnahmen nennen? Was wäre dies in diesem Fall?

Code:

---

Zähler_Benutzerparameter = BenutzerParameterAnlegen(ThisApplication.ActiveDocument, i, Eigenschaftenname, Wert, Beschreibung, Eigenschaftentabelle) 'Aufruf der Funktion "BenutzerParameterAnlegen"

---

Und noch zu guter Letzt werden in den Auswahllisten die Einträge mehrmals aufgelistet. Dies sieht man, wenn man im Dialog Parameter mit einem Rechten-Maus-Klick auf einen Parameter "Multivalue-Liste bearbeiten" auswählt. Dort sind die selben und identischen Auswahlmöglichkeiten mehrfach vorhanden.
Lässt sich das irgendwie verhindern, oder kann man doppelte wieder löschen?

Ich habe das mit der Zeilennummerierung aus dem anderen Thread eingearbeitet. Das klappt nun prima.

Unten habe ich nochmals den gesamten Code eingefügt. In der Anlage sind die Exceltabelle und die Baugruppe mit Unterbaugruppen und Bauteilen beigefügt. Darf ich Dich bitten, mich nochmals zu unterstützen? Ich traue mich schon fast nicht mehr zu fragen.

Ganz liebe Grüße
Stephan

Code:

---

'******************************************************************************************************************************
' Diese Programm erzeugt in Bauteilen (*.ipt) und/oder Baugruppen (*.iam) benutzerdefinierte Eigenschaften, die aus einer
' Exceltabelle eingelesen werden. Das Programm erzeugt die Eigenschaften in Baugruppen, Unterbaugruppen und den einzelnen
' Bauteilen in den Baugruppen und Unterbaugruppen.
' Buteilvarianten von iParts oder Baugruppenvarianten von iAssemblies werden ausgelassen, da von diesen die iProperties nicht
' geändert werden können
'
' Das Programm ist dazu gedacht, die im Projekt Pfaffensteigtunnel definierten Eigenschaften als benutzerdefinierte iProperties
' in den Baugruppen und Bauteilen anzulegen, damit diese für die BIM-Prozesse verwendet werden können.
'******************************************************************************************************************************

Sub Main()

Dim i As Integer
Dim Nummer_Eigenschaft As Integer

'********************************************************************
'Prüfung, ob ein Bauteil oder eine Baugruppe geöffnet und aktiv ist
'********************************************************************
If Not ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject And Not ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
MessageBox.Show("Die aktive Datei ist kein Beuteil oder keine Baugruppe!" & Chr(13) & Chr(13) & "Ein Bauteil (*.ipt) oder eine Baugruppe (*.iam) muss geöffnet bzw. aktiv sein.", "Inventor")
Exit Sub
End If

'**********************************************************************************************************
'Dateiauswahl für Exceltabelle mit benutzerdefinierten Projekt-Eigenschaften für Bauteile oder Baugruppen
'**********************************************************************************************************
Dim oFileDlg_Tabelle As Inventor.FileDialog = Nothing
ThisApplication.CreateFileDialog(oFileDlg_Tabelle)

Try
'oFileDlg_Tabelle.Filter = "XML Files (*.xml)|*.xml"
oFileDlg_Tabelle.Filter = "Excel Files (*.xls;*.xlsx;*.xlsm)|*.xls;*.xlsx;*.xlsm"
'oFileDlg_Tabelle.Filter = "Text Files (*.txt;*.csv)|*.txt;*.csv"
oFileDlg_Tabelle.DialogTitle = "Auswahl Excel-Tabelle mit projektspezifischen Eigenschaften Pfaffensteigtunnel aus BIMQ"
oFileDlg_Tabelle.InitialDirectory = ThisDoc.Path
oFileDlg_Tabelle.CancelError = True
oFileDlg_Tabelle.ShowOpen()

If oFileDlg_Tabelle.FileName <> "" Then
Eigenschaftentabelle = oFileDlg_Tabelle.FileName
'MessageBox.Show("Es wurde die folgende Datei mit Eigenschaften ausgewählt:" & Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Auswahl getätigt")
End If

Catch
MessageBox.Show("Keine Datei ausgewählt. Das Programm wird beendet.", "Dialog Abbruch")
Exit Sub
End Try

'***********************************
'Anzahl Zeilen in Tabelle ermitteln
'***********************************

GoExcel.TitleRow = 2
GoExcel.FindRowStart = 3

Dim Zeilen_Tabelle As Integer
Dim Anzahl_Eigenschaften As Integer

' Zeilen_Tabelle = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "<=", 50000)
' Anzahl_Eigenschaften = Zeilen_Tabelle - 2
' MessageBox.Show("In der ausgewählten Tabelle ist folgende Anzahl an Zeilen enthalten:" & Chr(13) & _
' Anzahl_Eigenschaften & Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Anzahl Zeilen", MessageBoxButtons.OK, MessageBoxIcon.Information)

' Zeilen_Tabelle = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "<=", 50000)
Zeilen_Tabelle = 20000
' Anzahl_Eigenschaften = Zeilen_Tabelle - 2

Anzahl_Eigenschaften = GoExcel.CellValues(Eigenschaftentabelle, "Tunnelbau", "F3", "F" & Zeilen_Tabelle).Count

'alternativ, wenn die Werteliste ebenfalls benötigt wird
'Dim aValues As ArrayList=GoExcel.CellValues(Eigenschaftentabelle, "Tunnelbau", "L3", "L" & Zeilen_Tabelle)
'Dim iCount As Integer = aValues.Count

MsgBox("Anzahl nichtleerer Zellen in Spalte F: " & Anzahl_Eigenschaften )

MessageBox.Show("In der ausgewählten Tabelle ist folgende Anzahl an Zeilen enthalten:" & Chr(13) & _
Anzahl_Eigenschaften & Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Anzahl Zeilen", MessageBoxButtons.OK, MessageBoxIcon.Information)

'*********************************************************************
'Eigenschaften aus Tabelle lesen und in Bauteil / Baugruppe erstellen
'*********************************************************************

Nummer_Eigenschaft = 0
Erzeugte_Eigenschaft = 0

Dim iCount As Integer
iCount = 1

'Für die Haupt-Baugruppe
If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Or ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then

For i = 1 To Anzahl_Eigenschaften
' ZeilenNr = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "=", i)
' Eigenschaftenname = GoExcel.CurrentRowValue("C")
' Wert = GoExcel.CurrentRowValue("Name")
' Datentyp = GoExcel.CurrentRowValue("Einheiten")
' Typ = GoExcel.CurrentRowValue("Typ")
' Beschreibung = GoExcel.CurrentRowValue("Beschreibung")

Dim Zelle_Ci As String = "C" & i ' Spalte C: Eigenschaftsname
Dim Zelle_Di As String = "D" & i ' Spalte D: Eigenscahftswert
Dim Zelle_Ii As String = "I" & i ' Spalte I: Einheit der Eigenschaft
Dim Zelle_Fi As String = "F" & i ' Spalte F: Datentyp der Eigenschaft
Dim Zelle_Hi As String = "H" & i ' Spalte H: Beschreibungatext der Eigenschaft bzw. des Eigenschaftswerts

Eigenschaftenname = GoExcel.CellValue(Zelle_Ci)
Wert = GoExcel.CellValue(Zelle_Di)
Datentyp = GoExcel.CellValue(Zelle_Ii)
Typ = GoExcel.CellValue(Zelle_Fi)
Beschreibung = GoExcel.CellValue(Zelle_Hi)

If Typ = "Eigenschaft" Then
MsgBox("1. If-Then: Eigenschaft - Spalte Name:" & vbCrLf & "Zeilennummer i: " & i & vbCrLf & "Eigenschaftenname: " & Eigenschaftenname & vbCrLf & "Wert: " & Wert & vbCrLf & "Beschreibung: " & Beschreibung)
Zähler_Eigenschaft = iPropertieCheck("", "Custom", Eigenschaftenname, "ND") 'Aufruf der Funktion "iPropertieCheck"
Erzeugte_Eigenschaft = Erzeugte_Eigenschaft + Zähler_Eigenschaft
Nummer_Eigenschaft = Nummer_Eigenschaft + 1
End If

If Typ = "Wert [Werteliste]" Then
MsgBox("2. If-Then: Wert [Werteliste] - Spalte Name:" & vbCrLf & "Zeilennummer i: " & i & vbCrLf & "Eigenschaftenname :" & Eigenschaftenname & vbCrLf & "Wert :" & Wert & vbCrLf & "Beschreibung: " & Beschreibung)
Zähler_Benutzerparameter = BenutzerParameterAnlegen(ThisApplication.ActiveDocument, i, Eigenschaftenname, Wert, Beschreibung, Eigenschaftentabelle) 'Aufruf der Funktion "BenutzerParameterAnlegen"
Erzeugter_Benutzerparameter = Erzeugter_Benutzerparameter + Zähler_Benutzerparameter
Nummer_Benutzerparameter = Nummer_Benutzerparameter + 1
End If
Next

End If

'Für jedes Bauteil und jede Unterbaugruppe in der Haupt-Baugruppe
If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
Dim oApp As Inventor.Application = ThisApplication
Dim oAssyDoc As Inventor.AssemblyDocument = oApp.ActiveDocument

For Each oSubDoc As Inventor.Document In oAssyDoc.AllReferencedDocuments

    If oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kPartDocumentObject Or oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kAssemblyDocumentObject Then

Try
'Wenn das Bauteil ein Inhaltcenter-Bauteil ist, dann überspringe das Bauteil
oCustomPropertySet = oSubDoc.PropertySets.Item("2DB9508F-CBA8-4714-ABE9-1A0EDB5B586C") 'ContentCenter in VBA
Exit Try
Catch
'Wenn es sich um ein iPart oder ein iAssembly handelt, dann überspringe das Bauteil
If oSubDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
Dim oPartDoc As PartDocument = DirectCast(oSubDoc,PartDocument)
If oPartDoc.ComponentDefinition.IsContentMember = True Then Continue For
If oPartDoc.ComponentDefinition.IsiPartMember = True Then Continue For
If oPartDoc.ComponentDefinition.IsiPartFactory = True Then Continue For
If oPartDoc.IsModifiable = False Then Continue For
End If

If oSubDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
Dim oAssDoc As AssemblyDocument = DirectCast(oSubDoc,AssemblyDocument)
If oAssDoc.ComponentDefinition.IsiAssemblyMember= True Then Continue For
If oAssDoc.ComponentDefinition.IsiAssemblyFactory = True Then Continue For
If oAssDoc.IsModifiable = False Then Continue For
End If

'Wenn das Bauteil ein "normales" Bauteil ist, dann erstelle die Eigenschaften
oCustomPropertySet = oSubDoc.PropertySets.Item("D5CDD505-2E9C-101B-9397-08002B2CF9AE") 'benutzerdefinierte iProperties

For i = 1 To Anzahl_Eigenschaften
' ZeilenNr = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "=", i)
' Eigenschaftenname = GoExcel.CurrentRowValue("C")
' Wert = GoExcel.CurrentRowValue("Name")
' Datentyp = GoExcel.CurrentRowValue("Einheiten")
' Typ = GoExcel.CurrentRowValue("Typ")
' Beschreibung = GoExcel.CurrentRowValue("Beschreibung")

Dim Zelle_Ci As String = "C" & i ' Spalte C: Eigenschaftsname
Dim Zelle_Di As String = "D" & i ' Spalte D: Eigenscahftswert
Dim Zelle_Ii As String = "I" & i ' Spalte I: Einheit der Eigenschaft
Dim Zelle_Fi As String = "F" & i ' Spalte F: Datentyp der Eigenschaft
Dim Zelle_Hi As String = "H" & i ' Spalte H: Beschreibungatext der Eigenschaft bzw. des Eigenschaftswerts

Eigenschaftenname = GoExcel.CellValue(Zelle_Ci)
Wert = GoExcel.CellValue(Zelle_Di)
Datentyp = GoExcel.CellValue(Zelle_Ii)
Typ = GoExcel.CellValue(Zelle_Fi)
Beschreibung = GoExcel.CellValue(Zelle_Hi)

If Typ = "Eigenschaft" Then
'MsgBox("1. If-Then: Eigenschaft - Spalte Name:" & vbCrLf & "Zeilennummer i: " & i & vbCrLf & "Eigenschaftenname: " & Eigenschaftenname & vbCrLf & "Wert: " & Wert & vbCrLf & "Beschreibung: " & Beschreibung)
Zähler_Eigenschaft = iPropertieCheck(GetDisplayName(oSubDoc),"Custom", Eigenschaftenname, "ND") 'Aufruf der Funktion "iPropertieCheck"
Erzeugte_Eigenschaft = Erzeugte_Eigenschaft + Zähler_Eigenschaft
Nummer_Eigenschaft = Nummer_Eigenschaft + 1
End If

If Typ = "Wert [Werteliste]" Then
'MsgBox("2. If-Then: Wert [Werteliste] - Spalte Name:" & vbCrLf & "Zeilennummer i: " & i & vbCrLf & "Eigenschaftenname :" & Eigenschaftenname & vbCrLf & "Wert :" & Wert & vbCrLf & "Beschreibung: " & Beschreibung)
Zähler_Benutzerparameter = BenutzerParameterAnlegen(oSubDoc, i, Eigenschaftenname, Wert, Beschreibung, Eigenschaftentabelle) 'Aufruf der Funktion "BenutzerParameterAnlegen"
Erzeugter_Benutzerparameter = Erzeugter_Benutzerparameter + Zähler_Benutzerparameter
Nummer_Benutzerparameter = Nummer_Benutzerparameter + 1
End If
Next
End Try
    End If

iCount = iCount + 1
Next
End If

MessageBox.Show("Es wurden alle fehlenden iProperties in den verbauten Baugruppen und Bauteilen angelegt." & Chr(13) & Chr(13) _
& "Es wurden in insgesamt " & iCount & " Bauteilen und Baugruppen die Eigenschaften erstellt." & Chr(13) & Chr(13) _
& "Es wurden insgesamt " & Nummer_Eigenschaft & " eindeutige Eigenschaften gelesen." & Chr(13) _
& "Es wurden in Summe " & Erzeugte_Eigenschaft & " neue Eigenschaften in den Bauteilen und Baugruppen angelegt." & Chr(13) _
& "Die restlichen Eigenschaften sind bereits vorhanden" & Chr(13) & Chr(13) & chr(13) _
& "Es wurden insgesamt " & Nummer_Benutzerparameter & " Benutzerparameter gelesen" & Chr(13) _
& "Es wurden in Summe " & Erzeugter_Benutzerparameter & " neue Benutzerparameter in den Bauteilen und Baugruppen angelegt." , "iPropertie", MessageBoxButtons.OK, MessageBoxIcon.Information)

End Sub

'########################################
'# Funktionen #
'########################################

'****************************************
'Funktion Prüfung iProperty und ergänzen
'****************************************

Private Function iPropertieCheck(Bauteilname As String, Reiter As String, Eigenschaft As String, Eigenschaftswert As String) As Integer
Try
iProp = iProperties.Value(Bauteilname, Reiter, Eigenschaft)
Catch
' MessageBox.Show("Das iPropertie """ & Eigenschaft & """ wurde nicht gefunden." & vbLf & vbLf & "Das iPropertie """ & Eigenschaft & """ wird in der Datei angelegt." _
' & vbLf & vbLf & "Der Inhalt des iPropertie ist: " & Eigenschaftswert, "iPropertie", MessageBoxButtons.OK, MessageBoxIcon.Information)

iProperties.Value(Bauteilname, Reiter, Eigenschaft) = Eigenschaftswert

Zähler_Eigenschaft = 1
Return Zähler_Eigenschaft
End Try
End Function

'****************************************
'Funktion Benutzerparameter als Text-Parameter mit Multiauswahlliste erstellen
'****************************************

Private Function BenutzerParameterAnlegen(oDoc As Document, Zeile As Integer , Eigenschaft As String, Eigenschaftswert As String, Eigenschaftsbeschreibung As String, Tabellenname As String, Optional Bauteilname As String = "") As Integer
'Erstellen der Benutzerparameter
Dim Benutzerparameter As UserParameters
Benutzerparameter = oDoc.ComponentDefinition.Parameters.UserParameters
Benutzerparametername = "z_" & Eigenschaft
'MsgBox("Benutzerparametername: "  & Benutzerparametername)
Try
BenPara = Benutzerparameter.Item(Benutzerparametername)
'MsgBox("Benutzerparametername: " & Benutzerparametername & " ist vorhanden.")
Catch
' MessageBox.Show("Der Benutzerparameter """ & Benutzerparametername & """ wurde nicht gefunden." & vbLf & vbLf & "Der Benutzerparameter """ & Benutzerparametername & """ wird in der Datei angelegt." _
' & vbLf & vbLf & "Der Inhalt des Benutzerparameters ist: " & Eigenschaft, "Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)

BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits)
'MsgBox("Der Benutzerparametername: "  & Benutzerparametername & " wurde angelegt.")

Zähler_Benutzerparameter = 1
Return Zähler_Benutzerparameter
End Try

'Erstellen der Mulitiauswahlliste
MsgBox("Erstellung der Multiauswahlliste:" & vbCrLf & "Zeilennummer i: " & Zeile & Chr(13) & "Eigenschaftenname: " & Eigenschaft & vbCrLf & "Eigenschaftswert: " & Eigenschaftswert & vbCrLf & "Eigenschaftsbeschreibung: " & Eigenschaftsbeschreibung & Chr(13) & "Eigenschaft: " & Benutzerparametername)

' die Zeile aktivieren, damit beim Erzeugen/Ändern der Multivalueliste der in DefaultIndex definierte Wert ausgewählt wird.
' MultiValue.SetValueOptions(True, DefaultIndex :=0)

Dim Liste As New ArrayList
If Bauteilname="" Then
Liste = MultiValue.List(Benutzerparametername)
Else
Liste = MultiValue.List(Bauteilname, Benutzerparametername)
End If

If Eigenschaftsbeschreibung = "" Then
Eigenschaftsbeschreibung = "-"
End If
Liste.Add(Eigenschaftsbeschreibung)
If Bauteilname="" Then
MultiValue.List(Benutzerparametername) = Liste
Else
MultiValue.List(Bauteilname, Benutzerparametername) = Liste
End If

'Ausgabedialog zur Kontrolle - kann auskommentiert werden!
MsgBox("Es wurde folgender Benutzerparameter mit einer Auswahlliste befüllt: " & Chr(13) & Benutzerparametername & Chr(13) & _
  "Der Benutzerparameter enthält derzeit den Wert: " & Chr(13) & Parameter(Benutzerparametername))

Zähler_Benutzerparameter = 1
Return Zähler_Benutzerparameter

End Function

'****************************************
'Funktion Abfrage Anzeigename von Teilen
'****************************************
Private Function GetDisplayName(oTeil As Inventor.Document) As String
If oTeil.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
Return GetDisplayName(DirectCast(oTeil,Inventor.PartDocument))
Else
Return GetDisplayName(DirectCast(oTeil,Inventor.AssemblyDocument))
End If
End Function

'****************************************
'Funktion Abfrage Anzeigename von Bauteilen
'****************************************
Private Function GetDisplayName(oBauteil As Inventor.PartDocument) As String
If oBauteil.ComponentDefinition.IsModelStateMember = True Then
oBauteil = DirectCast(oBauteil.ComponentDefinition.FactoryDocument,Inventor.PartDocument)
End If
Return oBauteil.DisplayName
End Function

'****************************************
'Funktion Abfrage Anzeigename von Baugruppen
'****************************************
Private Function GetDisplayName(oBaugruppe As Inventor.AssemblyDocument) As String
If oBaugruppe.ComponentDefinition.IsModelStateMember = True Then
oBaugruppe = DirectCast(oBaugruppe.ComponentDefinition.FactoryDocument,Inventor.AssemblyDocument)
End If
Return oBaugruppe.DisplayName
End Function

---

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

---

Guten Morgen,

mit etwas Abstand und ausgeschlafen geht es dann doch wieder etwas besser.
Das Problem, dass die MultiAuswahl-Listen nicht immer oder nicht vollständig erstellt wurden, lag daran, dass die Funktion "BenutzerParameterAnlegen" nach dem Befehl Try-Catch beim ertsen Durchgang immer verlassen wurde und der Teil nach dem "End Try" für die Erstellung der Multivalue-Liste nicht ausgeführt wurde - warum auch immer.
Ich habe nun die Erstellung der Multivalue-Liste in eine separate Funktion "MultiauswahllisteAnlegen" gepackt und rufe diese Funktion in den Try-Catch-Anweisungen in der Funktion "BenutzerParameterAnlegen" auf.
Damit werden die Multivalue-Listen in der Hauptbaugruppe richtig und vollständig angelegt.

Allerdings sind die gleichen Inhalte der Auswahllisten immer noch mehrmals vorhanden, da bei jedem Funktionsaufruf die Werte nochmals angelegt werden (siehe meinen Beitrag von gestern Abend). Das muss ich noch irgendwie abfangen. Hast Du eine Idee, wie ich das machen kann?

Es klappt aber immer noch nicht, dass die Auswahllisten auch in den Unterbaugruppe und Bauteilen angelegt werden (siehe meinen Beitrag von gestern Abend).

Wo steckt da noch der Fehler? Ich sehe ihn leider nicht.
Danke für die Unterstützung.
Liebe Grüße
Stephan

Code:

---

'******************************************************************************************************************************
' Diese Programm erzeugt in Bauteilen (*.ipt) und/oder Baugruppen (*.iam) benutzerdefinierte Eigenschaften, die aus einer
' Exceltabelle eingelesen werden. Das Programm erzeugt die Eigenschaften in Baugruppen, Unterbaugruppen und den einzelnen
' Bauteilen in den Baugruppen und Unterbaugruppen.
' Buteilvarianten von iParts oder Baugruppenvarianten von iAssemblies werden ausgelassen, da von diesen die iProperties nicht
' geändert werden können
'
' Das Programm ist dazu gedacht, die im Projekt Pfaffensteigtunnel definierten Eigenschaften als benutzerdefinierte iProperties
' in den Baugruppen und Bauteilen anzulegen, damit diese für die BIM-Prozesse verwendet werden können.
'******************************************************************************************************************************

Sub Main()

Dim i As Integer
Dim Nummer_Eigenschaft As Integer

'********************************************************************
'Prüfung, ob ein Bauteil oder eine Baugruppe geöffnet und aktiv ist
'********************************************************************
If Not ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject And Not ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
MessageBox.Show("Die aktive Datei ist kein Beuteil oder keine Baugruppe!" & Chr(13) & Chr(13) & "Ein Bauteil (*.ipt) oder eine Baugruppe (*.iam) muss geöffnet bzw. aktiv sein.", "Inventor")
Exit Sub
End If

'**********************************************************************************************************
'Dateiauswahl für Exceltabelle mit benutzerdefinierten Projekt-Eigenschaften für Bauteile oder Baugruppen
'**********************************************************************************************************
Dim oFileDlg_Tabelle As Inventor.FileDialog = Nothing
ThisApplication.CreateFileDialog(oFileDlg_Tabelle)

Try
'oFileDlg_Tabelle.Filter = "XML Files (*.xml)|*.xml"
oFileDlg_Tabelle.Filter = "Excel Files (*.xls;*.xlsx;*.xlsm)|*.xls;*.xlsx;*.xlsm"
'oFileDlg_Tabelle.Filter = "Text Files (*.txt;*.csv)|*.txt;*.csv"
oFileDlg_Tabelle.DialogTitle = "Auswahl Excel-Tabelle mit projektspezifischen Eigenschaften Pfaffensteigtunnel aus BIMQ"
oFileDlg_Tabelle.InitialDirectory = ThisDoc.Path
oFileDlg_Tabelle.CancelError = True
oFileDlg_Tabelle.ShowOpen()

If oFileDlg_Tabelle.FileName <> "" Then
Eigenschaftentabelle = oFileDlg_Tabelle.FileName
'MessageBox.Show("Es wurde die folgende Datei mit Eigenschaften ausgewählt:" & Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Auswahl getätigt")
End If

Catch
MessageBox.Show("Keine Datei ausgewählt. Das Programm wird beendet.", "Dialog Abbruch")
Exit Sub
End Try

'***********************************
'Anzahl Zeilen in Tabelle ermitteln
'***********************************

GoExcel.TitleRow = 2
GoExcel.FindRowStart = 3

Dim Zeilen_Tabelle As Integer
Dim Anzahl_Eigenschaften As Integer

' Zeilen_Tabelle = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "<=", 50000)
' Anzahl_Eigenschaften = Zeilen_Tabelle - 2
' MessageBox.Show("In der ausgewählten Tabelle ist folgende Anzahl an Zeilen enthalten:" & Chr(13) & _
' Anzahl_Eigenschaften & Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Anzahl Zeilen", MessageBoxButtons.OK, MessageBoxIcon.Information)

' Zeilen_Tabelle = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "<=", 50000)
Zeilen_Tabelle = 20000
' Anzahl_Eigenschaften = Zeilen_Tabelle - 2

Anzahl_Eigenschaften = GoExcel.CellValues(Eigenschaftentabelle, "Tunnelbau", "F3", "F" & Zeilen_Tabelle).Count

'alternativ, wenn die Werteliste ebenfalls benötigt wird
'Dim aValues As ArrayList=GoExcel.CellValues(Eigenschaftentabelle, "Tunnelbau", "L3", "L" & Zeilen_Tabelle)
'Dim iCount As Integer = aValues.Count

'MsgBox("Anzahl nichtleerer Zellen in Spalte F: " & Anzahl_Eigenschaften )

MessageBox.Show("In der ausgewählten Tabelle ist folgende Anzahl an ausgefüllten Zeilen enthalten:" & Chr(13) & _
Anzahl_Eigenschaften & Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Anzahl Zeilen", MessageBoxButtons.OK, MessageBoxIcon.Information)

'*********************************************************************
'Eigenschaften aus Tabelle lesen und in Bauteil / Baugruppe erstellen
'*********************************************************************

Nummer_Eigenschaft = 0
Erzeugte_Eigenschaft = 0

Dim iCount As Integer
iCount = 1

'Für die Haupt-Baugruppe
If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Or ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then

For i = 1 To Anzahl_Eigenschaften
' ZeilenNr = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "=", i)
' Eigenschaftenname = GoExcel.CurrentRowValue("C")
' Wert = GoExcel.CurrentRowValue("Name")
' Datentyp = GoExcel.CurrentRowValue("Einheiten")
' Typ = GoExcel.CurrentRowValue("Typ")
' Beschreibung = GoExcel.CurrentRowValue("Beschreibung")

Dim Zelle_Ci As String = "C" & i ' Spalte C: Eigenschaftsname
Dim Zelle_Di As String = "D" & i ' Spalte D: Eigenscahftswert
Dim Zelle_Ii As String = "I" & i ' Spalte I: Einheit der Eigenschaft
Dim Zelle_Fi As String = "F" & i ' Spalte F: Datentyp der Eigenschaft
Dim Zelle_Hi As String = "H" & i ' Spalte H: Beschreibungatext der Eigenschaft bzw. des Eigenschaftswerts

Eigenschaftenname = GoExcel.CellValue(Zelle_Ci)
Wert = GoExcel.CellValue(Zelle_Di)
Datentyp = GoExcel.CellValue(Zelle_Ii)
Typ = GoExcel.CellValue(Zelle_Fi)
Beschreibung = GoExcel.CellValue(Zelle_Hi)

If Typ = "Eigenschaft" Then
MsgBox("1. If-Then: Eigenschaft - Spalte Name:" & vbCrLf & vbCrLf & "Zeilennummer i: " & i & vbCrLf & "Eigenschaftenname: " & Eigenschaftenname & vbCrLf & "Wert: " & Wert & vbCrLf & "Beschreibung: " & Beschreibung)
Zähler_Eigenschaft = iPropertieCheck("", "Custom", Eigenschaftenname, "ND") 'Aufruf der Funktion "iPropertieCheck"
Erzeugte_Eigenschaft = Erzeugte_Eigenschaft + Zähler_Eigenschaft
Nummer_Eigenschaft = Nummer_Eigenschaft + 1
End If

If Typ = "Wert [Werteliste]" Then
MsgBox("2. If-Then: Wert [Werteliste] - Spalte Name:" & vbCrLf & vbCrLf & "Zeilennummer i: " & i & vbCrLf & "Eigenschaftenname :" & Eigenschaftenname & vbCrLf & "Wert :" & Wert & vbCrLf & "Beschreibung: " & Beschreibung)
Zähler_Benutzerparameter = BenutzerParameterAnlegen(ThisApplication.ActiveDocument, i, Eigenschaftenname, Wert, Beschreibung, Eigenschaftentabelle) 'Aufruf der Funktion "BenutzerParameterAnlegen"
Erzeugter_Benutzerparameter = Erzeugter_Benutzerparameter + Zähler_Benutzerparameter
Nummer_Benutzerparameter = Nummer_Benutzerparameter + 1
End If
Next

End If

'Für jedes Bauteil und jede Unterbaugruppe in der Haupt-Baugruppe
If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
Dim oApp As Inventor.Application = ThisApplication
Dim oAssyDoc As Inventor.AssemblyDocument = oApp.ActiveDocument

For Each oSubDoc As Inventor.Document In oAssyDoc.AllReferencedDocuments

    If oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kPartDocumentObject Or oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kAssemblyDocumentObject Then

Try
'Wenn das Bauteil ein Inhaltcenter-Bauteil ist, dann überspringe das Bauteil
oCustomPropertySet = oSubDoc.PropertySets.Item("2DB9508F-CBA8-4714-ABE9-1A0EDB5B586C") 'ContentCenter in VBA
Exit Try
Catch
'Wenn es sich um ein iPart oder ein iAssembly handelt, dann überspringe das Bauteil
If oSubDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
Dim oPartDoc As PartDocument = DirectCast(oSubDoc,PartDocument)
If oPartDoc.ComponentDefinition.IsContentMember = True Then Continue For
If oPartDoc.ComponentDefinition.IsiPartMember = True Then Continue For
If oPartDoc.ComponentDefinition.IsiPartFactory = True Then Continue For
If oPartDoc.IsModifiable = False Then Continue For
End If

If oSubDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
Dim oAssDoc As AssemblyDocument = DirectCast(oSubDoc,AssemblyDocument)
If oAssDoc.ComponentDefinition.IsiAssemblyMember= True Then Continue For
If oAssDoc.ComponentDefinition.IsiAssemblyFactory = True Then Continue For
If oAssDoc.IsModifiable = False Then Continue For
End If

'Wenn das Bauteil ein "normales" Bauteil ist, dann erstelle die Eigenschaften
oCustomPropertySet = oSubDoc.PropertySets.Item("D5CDD505-2E9C-101B-9397-08002B2CF9AE") 'benutzerdefinierte iProperties

For i = 1 To Anzahl_Eigenschaften
' ZeilenNr = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "=", i)
' Eigenschaftenname = GoExcel.CurrentRowValue("C")
' Wert = GoExcel.CurrentRowValue("Name")
' Datentyp = GoExcel.CurrentRowValue("Einheiten")
' Typ = GoExcel.CurrentRowValue("Typ")
' Beschreibung = GoExcel.CurrentRowValue("Beschreibung")

Dim Zelle_Ci As String = "C" & i ' Spalte C: Eigenschaftsname
Dim Zelle_Di As String = "D" & i ' Spalte D: Eigenscahftswert
Dim Zelle_Ii As String = "I" & i ' Spalte I: Einheit der Eigenschaft
Dim Zelle_Fi As String = "F" & i ' Spalte F: Datentyp der Eigenschaft
Dim Zelle_Hi As String = "H" & i ' Spalte H: Beschreibungatext der Eigenschaft bzw. des Eigenschaftswerts

Eigenschaftenname = GoExcel.CellValue(Zelle_Ci)
Wert = GoExcel.CellValue(Zelle_Di)
Datentyp = GoExcel.CellValue(Zelle_Ii)
Typ = GoExcel.CellValue(Zelle_Fi)
Beschreibung = GoExcel.CellValue(Zelle_Hi)

If Typ = "Eigenschaft" Then
'MsgBox("1. If-Then: Eigenschaft - Spalte Name:" & vbCrLf & "Zeilennummer i: " & i & vbCrLf & "Eigenschaftenname: " & Eigenschaftenname & vbCrLf & "Wert: " & Wert & vbCrLf & "Beschreibung: " & Beschreibung)
Zähler_Eigenschaft = iPropertieCheck(GetDisplayName(oSubDoc),"Custom", Eigenschaftenname, "ND") 'Aufruf der Funktion "iPropertieCheck"
Erzeugte_Eigenschaft = Erzeugte_Eigenschaft + Zähler_Eigenschaft
Nummer_Eigenschaft = Nummer_Eigenschaft + 1
End If

If Typ = "Wert [Werteliste]" Then
'MsgBox("2. If-Then: Wert [Werteliste] - Spalte Name:" & vbCrLf & "Zeilennummer i: " & i & vbCrLf & "Eigenschaftenname :" & Eigenschaftenname & vbCrLf & "Wert :" & Wert & vbCrLf & "Beschreibung: " & Beschreibung)
Zähler_Benutzerparameter = BenutzerParameterAnlegen(oSubDoc, i, Eigenschaftenname, Wert, Beschreibung, Eigenschaftentabelle) 'Aufruf der Funktion "BenutzerParameterAnlegen"
Erzeugter_Benutzerparameter = Erzeugter_Benutzerparameter + Zähler_Benutzerparameter
Nummer_Benutzerparameter = Nummer_Benutzerparameter + 1
End If
Next
End Try
    End If

iCount = iCount + 1
Next
End If

MessageBox.Show("Es wurden alle fehlenden iProperties in den verbauten Baugruppen und Bauteilen angelegt." & Chr(13) & Chr(13) _
& "Es wurden in insgesamt " & iCount & " Bauteilen und Baugruppen die Eigenschaften erstellt." & Chr(13) & Chr(13) _
& "Es wurden insgesamt " & Nummer_Eigenschaft & " eindeutige Eigenschaften gelesen." & Chr(13) _
& "Es wurden in Summe " & Erzeugte_Eigenschaft & " neue Eigenschaften in den Bauteilen und Baugruppen angelegt." & Chr(13) _
& "Die restlichen Eigenschaften sind bereits vorhanden" & Chr(13) & Chr(13) & chr(13) _
& "Es wurden insgesamt " & Nummer_Benutzerparameter & " Benutzerparameter gelesen" & Chr(13) _
& "Es wurden in Summe " & Erzeugter_Benutzerparameter & " neue Benutzerparameter in den Bauteilen und Baugruppen angelegt." , "iPropertie", MessageBoxButtons.OK, MessageBoxIcon.Information)

End Sub

'########################################
'# Funktionen #
'########################################

'****************************************
'Funktion Prüfung iProperty und ergänzen
'****************************************

Private Function iPropertieCheck(Bauteilname As String, Reiter As String, Eigenschaft As String, Eigenschaftswert As String) As Integer
Try
iProp = iProperties.Value(Bauteilname, Reiter, Eigenschaft)
Catch
' MessageBox.Show("Das iPropertie """ & Eigenschaft & """ wurde nicht gefunden." & vbLf & vbLf & "Das iPropertie """ & Eigenschaft & """ wird in der Datei angelegt." _
' & vbLf & vbLf & "Der Inhalt des iPropertie ist: " & Eigenschaftswert, "iPropertie", MessageBoxButtons.OK, MessageBoxIcon.Information)

iProperties.Value(Bauteilname, Reiter, Eigenschaft) = Eigenschaftswert

Zähler_Eigenschaft = 1
Return Zähler_Eigenschaft
End Try
End Function

'****************************************
'Funktion Benutzerparameter als Text-Parameter mit Multiauswahlliste erstellen
'****************************************

Private Function BenutzerParameterAnlegen(oDoc As Document, Zeile As Integer , Eigenschaft As String, Eigenschaftswert As String, Eigenschaftsbeschreibung As String, Tabellenname As String, Optional Bauteilname As String = "") As Integer
'Erstellen der Benutzerparameter
Dim Benutzerparameter As UserParameters
Benutzerparameter = oDoc.ComponentDefinition.Parameters.UserParameters
Benutzerparametername = "z_" & Eigenschaft
MsgBox("Benutzerparametername: "  & Benutzerparametername)
Try
BenPara = Benutzerparameter.Item(Benutzerparametername)
MsgBox("Benutzerparametername: " & Benutzerparametername & " ist vorhanden.")
MultiauswahllisteAnlegen(oDoc, Zeile, Eigenschaft, Eigenschaftswert, Eigenschaftsbeschreibung, Benutzerparametername, Tabellenname) 'Aufruf der Funktion "MultiauswahllisteAnlegen"
Catch
MessageBox.Show("Der Benutzerparameter """ & Benutzerparametername & """ wurde nicht gefunden." & vbLf & vbLf & "Der Benutzerparameter """ & Benutzerparametername & """ wird in der Datei angelegt." _
& vbLf & vbLf & "Der Inhalt des Benutzerparameters ist: " & Eigenschaft, "Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)

BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits)
MsgBox("Der Benutzerparametername: "  & Benutzerparametername & " wurde angelegt.")

MultiauswahllisteAnlegen(oDoc, Zeile, Eigenschaft, Eigenschaftswert, Eigenschaftsbeschreibung, Benutzerparametername, Tabellenname) 'Aufruf der Funktion "MultiauswahllisteAnlegen"

Zähler_Benutzerparameter = 1
Return Zähler_Benutzerparameter
End Try
End Function

'****************************************
'Funktion Multiauswahlliste für Benutzerparameter erstellen
'****************************************

Private Function MultiauswahllisteAnlegen(oDoc As Document, Zeile As Integer , Eigenschaft As String, Eigenschaftswert As String, Eigenschaftsbeschreibung As String, Benutzerparametername As String, Tabellenname As String, Optional Bauteilname As String = "") As Integer
'Erstellen der Mulitiauswahlliste
MsgBox("Erstellung der Multiauswahlliste:" & vbCrLf & "Zeilennummer i: " & Zeile & Chr(13) & "Eigenschaftenname: " & Eigenschaft & vbCrLf & "Eigenschaftswert: " & Eigenschaftswert & vbCrLf & "Eigenschaftsbeschreibung: " & Eigenschaftsbeschreibung & Chr(13) & "Eigenschaft: " & Benutzerparametername)

' die Zeile aktivieren, damit beim Erzeugen/Ändern der Multivalueliste der in DefaultIndex definierte Wert ausgewählt wird.
' MultiValue.SetValueOptions(True, DefaultIndex :=0)

Dim Liste As New ArrayList
If Bauteilname="" Then
Liste = MultiValue.List(Benutzerparametername)
Else
Liste = MultiValue.List(Bauteilname, Benutzerparametername)
End If

If Eigenschaftsbeschreibung = "" Then
Eigenschaftsbeschreibung = "nd"
End If
Liste.Add(Eigenschaftsbeschreibung)
If Bauteilname="" Then
MultiValue.List(Benutzerparametername) = Liste
Else
MultiValue.List(Bauteilname, Benutzerparametername) = Liste
End If

'Ausgabedialog zur Kontrolle - kann auskommentiert werden!
MsgBox("Es wurde folgender Benutzerparameter mit einer Auswahlliste befüllt: " & Chr(13) & Benutzerparametername & Chr(13) & _
   "Der Benutzerparameter enthält derzeit den Wert: " & Chr(13) & Parameter(Benutzerparametername))

Zähler_Benutzerparameter = 1
Return Zähler_Benutzerparameter

End Function

'****************************************
'Funktion Abfrage Anzeigename von Teilen
'****************************************
Private Function GetDisplayName(oTeil As Inventor.Document) As String
If oTeil.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
Return GetDisplayName(DirectCast(oTeil,Inventor.PartDocument))
Else
Return GetDisplayName(DirectCast(oTeil,Inventor.AssemblyDocument))
End If
End Function

'****************************************
'Funktion Abfrage Anzeigename von Bauteilen
'****************************************
Private Function GetDisplayName(oBauteil As Inventor.PartDocument) As String
If oBauteil.ComponentDefinition.IsModelStateMember = True Then
oBauteil = DirectCast(oBauteil.ComponentDefinition.FactoryDocument,Inventor.PartDocument)
End If
Return oBauteil.DisplayName
End Function

'****************************************
'Funktion Abfrage Anzeigename von Baugruppen
'****************************************
Private Function GetDisplayName(oBaugruppe As Inventor.AssemblyDocument) As String
If oBaugruppe.ComponentDefinition.IsModelStateMember = True Then
oBaugruppe = DirectCast(oBaugruppe.ComponentDefinition.FactoryDocument,Inventor.AssemblyDocument)
End If
Return oBaugruppe.DisplayName
End Function

---

[Diese Nachricht wurde von FroSte am 29. Okt. 2024 editiert.]

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

---

Moin

In deiner Funktion MultiValueListeAnlegen fügst du immer den Wert für die Eigenschaftsbeschreibung hinzu. Arraylisten lassen Duplikate zu. Du musst vorher prüfen, ob es den Wert schon gibt. Dafür kann man beispielsweise die Methode Liste.Contains benutzen.

Das Optional bewirkt, das eine Funktion auch ohne dieses Argument aufgerufen werden kann, ohne das es einen Fehler erzeugt. Da die Variable in der Funktion aber benutzt wird, braucht sie natürlich einen Wert. Der wird ihr als Default in der Argumentliste der Funktion zugewiesen. Man könnte auch alternativ das optional weglassen und bei jedem Funktionsaufruf ein "" mitgeben, wenn es keinen Bauteilnamen gibt.
Du rufst die Funktion MultiValueListeAnlegen immer ohne das Argument Bauteilname auf. Dadurch wird immer der Defaultwert "" genommen. Das ist falsch. Das Argument sollte hier nicht optional sein, da beim Aufruf aus der Funktion BenutzerParameterAnlegen die Variable Bauteilname existiert und einen Wert hat. Dieser Wert muss mit übergeben werden.

Ich habe die beiden Funktionen überarbeitet, so dass du sie direkt kopieren kannst.
Hab ich jetzt was vergessen?

Code:

---

'****************************************
'Funktion Benutzerparameter als Text-Parameter mit Multiauswahlliste erstellen
'****************************************

Private Function BenutzerParameterAnlegen(oDoc As Document, Zeile As Integer , Eigenschaft As String, Eigenschaftswert As String, Eigenschaftsbeschreibung As String, Tabellenname As String, Optional Bauteilname As String = "") As Integer
'Erstellen der Benutzerparameter
Dim Benutzerparameter As UserParameters
Benutzerparameter = oDoc.ComponentDefinition.Parameters.UserParameters
Benutzerparametername = "z_" & Eigenschaft
MsgBox("Benutzerparametername: "  & Benutzerparametername)
Try
BenPara = Benutzerparameter.Item(Benutzerparametername)
MsgBox("Benutzerparametername: " & Benutzerparametername & " ist vorhanden.")
MultiauswahllisteAnlegen(oDoc, Zeile, Eigenschaft, Eigenschaftswert, Eigenschaftsbeschreibung, Benutzerparametername, Tabellenname, Bauteilname) 'Aufruf der Funktion "MultiauswahllisteAnlegen"
Catch
MessageBox.Show("Der Benutzerparameter """ & Benutzerparametername & """ wurde nicht gefunden." & vbLf & vbLf & "Der Benutzerparameter """ & Benutzerparametername & """ wird in der Datei angelegt." _
& vbLf & vbLf & "Der Inhalt des Benutzerparameters ist: " & Eigenschaft, "Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)

BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits)
MsgBox("Der Benutzerparametername: "  & Benutzerparametername & " wurde angelegt.")

MultiauswahllisteAnlegen(oDoc, Zeile, Eigenschaft, Eigenschaftswert, Eigenschaftsbeschreibung, Benutzerparametername, Tabellenname, Bauteilname) 'Aufruf der Funktion "MultiauswahllisteAnlegen"


Zähler_Benutzerparameter = 1
Return Zähler_Benutzerparameter
End Try
End Function

'****************************************
'Funktion Multiauswahlliste für Benutzerparameter erstellen
'****************************************

Private Function MultiauswahllisteAnlegen(oDoc As Document, Zeile As Integer , Eigenschaft As String, Eigenschaftswert As String, Eigenschaftsbeschreibung As String, Benutzerparametername As String, Tabellenname As String, Bauteilname As String) As Integer
'Erstellen der Mulitiauswahlliste
MsgBox("Erstellung der Multiauswahlliste:" & vbCrLf & "Zeilennummer i: " & Zeile & Chr(13) & "Eigenschaftenname: " & Eigenschaft & vbCrLf & "Eigenschaftswert: " & Eigenschaftswert & vbCrLf & "Eigenschaftsbeschreibung: " & Eigenschaftsbeschreibung & Chr(13) & "Eigenschaft: " & Benutzerparametername)

' die Zeile aktivieren, damit beim Erzeugen/Ändern der Multivalueliste der in DefaultIndex definierte Wert ausgewählt wird.
' MultiValue.SetValueOptions(True, DefaultIndex :=0)

Dim Liste As New ArrayList
If Bauteilname="" Then
Liste = MultiValue.List(Benutzerparametername)
Else
Liste = MultiValue.List(Bauteilname, Benutzerparametername)
End If

If Eigenschaftsbeschreibung = "" Then
Eigenschaftsbeschreibung = "nd"
End If

If Not Liste.Contains(Eigenschaftsbeschreibung) Then Liste.Add(Eigenschaftsbeschreibung)

If Bauteilname = "" Then
MultiValue.List(Benutzerparametername) = Liste
Else
MultiValue.List(Bauteilname, Benutzerparametername) = Liste
End If

'Ausgabedialog zur Kontrolle - kann auskommentiert werden!
MsgBox("Es wurde folgender Benutzerparameter mit einer Auswahlliste befüllt: " & Chr(13) & Benutzerparametername & Chr(13) & _
   "Der Benutzerparameter enthält derzeit den Wert: " & Chr(13) & Parameter(Benutzerparametername))

Zähler_Benutzerparameter = 1
Return Zähler_Benutzerparameter

End Function

---

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

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

---

Hallo Ralf,

vielen Dank für Deine Unterstützung und die Erklärungen. das hat mir schon sehr geholfen.
Das mit der Arrayliste und den doppelten Eintragungen habe ich hinbekommen. Es werden jetzt auch beim mehrmaligen Ausführen des Codes keine Einträge mehr mehrfach in den Listen erzeugt.

Das mit den Optional habe ich auch nun auch verstanden. Das kannte ich vorher noch nicht.

Danke auch, dass Du die Funktionen entsprechend angepasst hast.
Aber leider werden in den Unterbaugruppen und deren Bauteile noch immer zwar die Benutzerparameter erzeugt, aber die Multiauswahllisten zu den jeweiligen Benutzerparameter nicht.
In der Hauptbaugruppe klappt das ohne Probleme.

Das ist wirklich eine harte Nuss....

Ich hänge hier nochmals meinen vollständigen Code an. Ich habe inzwischen auch noch ein paar Auswahlmöglichkeiten eingebaut, um nicht immer alle Benutzerparameter aus der gesamten Excelliste anzulegen, sondern eine Auswahl eines einzelnen Objektes (aus der Spalte A der Exceltabelle) treffen zu können. 

Code:

---

'******************************************************************************************************************************
' Diese Programm erzeugt in Bauteilen (*.ipt) und/oder Baugruppen (*.iam) benutzerdefinierte Eigenschaften, die aus einer
' Exceltabelle eingelesen werden. Das Programm erzeugt die Eigenschaften in Baugruppen, Unterbaugruppen und den einzelnen
' Bauteilen in den Baugruppen und Unterbaugruppen.
' Buteilvarianten von iParts oder Baugruppenvarianten von iAssemblies werden ausgelassen, da von diesen die iProperties nicht
' geändert werden können
'
' Das Programm ist dazu gedacht, die im Projekt Pfaffensteigtunnel definierten Eigenschaften als benutzerdefinierte iProperties
' in den Baugruppen und Bauteilen anzulegen, damit diese für die BIM-Prozesse verwendet werden können.
'******************************************************************************************************************************

Sub Main()

Dim i As Integer
Dim Nummer_Eigenschaft As Integer

'********************************************************************
'Prüfung, ob ein Bauteil oder eine Baugruppe geöffnet und aktiv ist
'********************************************************************
If Not ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject And Not ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
MessageBox.Show("Die aktive Datei ist kein Beuteil oder keine Baugruppe!" & Chr(13) & Chr(13) & "Ein Bauteil (*.ipt) oder eine Baugruppe (*.iam) muss geöffnet bzw. aktiv sein.", "Inventor")
Exit Sub
End If

'**********************************************************************************************************
'Dateiauswahl für Exceltabelle mit benutzerdefinierten Projekt-Eigenschaften für Bauteile oder Baugruppen
'**********************************************************************************************************
Dim oFileDlg_Tabelle As Inventor.FileDialog = Nothing
ThisApplication.CreateFileDialog(oFileDlg_Tabelle)

Try
'oFileDlg_Tabelle.Filter = "XML Files (*.xml)|*.xml"
oFileDlg_Tabelle.Filter = "Excel Files (*.xls;*.xlsx;*.xlsm)|*.xls;*.xlsx;*.xlsm"
'oFileDlg_Tabelle.Filter = "Text Files (*.txt;*.csv)|*.txt;*.csv"
oFileDlg_Tabelle.DialogTitle = "Auswahl Excel-Tabelle mit projektspezifischen Eigenschaften Pfaffensteigtunnel aus BIMQ"
oFileDlg_Tabelle.InitialDirectory = ThisDoc.Path
oFileDlg_Tabelle.CancelError = True
oFileDlg_Tabelle.ShowOpen()

If oFileDlg_Tabelle.FileName <> "" Then
Eigenschaftentabelle = oFileDlg_Tabelle.FileName
'MessageBox.Show("Es wurde die folgende Datei mit Eigenschaften ausgewählt:" & Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Auswahl getätigt")
End If

Catch
MessageBox.Show("Keine Datei ausgewählt. Das Programm wird beendet.", "Dialog Abbruch")
Exit Sub
End Try

'***********************************
'Anzahl Zeilen in Tabelle ermitteln
'***********************************

GoExcel.TitleRow = 0
GoExcel.FindRowStart = 1

Dim Zeilen_Tabelle As Integer
Dim Anzahl_Eigenschaften As Integer
Dim Anzahl_Zeilen As Integer

' Zeilen_Tabelle = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "<=", 50000)
' Anzahl_Eigenschaften = Zeilen_Tabelle - 2
' MessageBox.Show("In der ausgewählten Tabelle ist folgende Anzahl an Zeilen enthalten:" & Chr(13) & _
' Anzahl_Eigenschaften & Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Anzahl Zeilen", MessageBoxButtons.OK, MessageBoxIcon.Information)

' Zeilen_Tabelle = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "<=", 50000)
Zeilen_Tabelle = 20000
' Anzahl_Eigenschaften = Zeilen_Tabelle - 2

Anzahl_Eigenschaften = GoExcel.CellValues(Eigenschaftentabelle, "Tunnelbau", "F3", "F" & Zeilen_Tabelle).Count
Anzahl_Zeilen = Anzahl_Eigenschaften + 2

'alternativ, wenn die Werteliste ebenfalls benötigt wird
'Dim aValues As ArrayList=GoExcel.CellValues(Eigenschaftentabelle, "Tunnelbau", "L3", "L" & Zeilen_Tabelle)
'Dim Anzahl_Eigenschaften As Integer = aValues.Count

'MsgBox("Anzahl nichtleerer Zellen in Spalte F: " & Anzahl_Eigenschaften )

MessageBox.Show("In der ausgewählten Tabelle ist folgende Anzahl an ausgefüllten Zeilen enthalten:" & Chr(13) & _
Anzahl_Eigenschaften & Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Anzahl Zeilen", MessageBoxButtons.OK, MessageBoxIcon.Information)

'*********************************************************************
'Auswahl des Objektes, für das die Eigensaahften gelesen werden soll
'*********************************************************************
Dim Anzahl_Objekte As Integer
Dim Objektname As String
Dim Objektliste As New ArrayList
Dim Startzeile As Integer
Dim Endzeile As Integer
Dim AnzahlEigenschaftenObjekt As Integer

Objektliste.Add("Alle")
'Anzahl und Werteliste aus der Spalte A
' Dim Objektliste As ArrayList=GoExcel.CellValues(Eigenschaftentabelle, "Tunnelbau", "A3", "A" & Anzahl_Eigenschaften)
' Anzahl_Objekte = Objektliste.Count

For i = 1 To Anzahl_Eigenschaften
Dim Zelle_Ai As String = "A" & i ' Spalte A: Objektname
Objektname = GoExcel.CellValue(Zelle_Ai)

If Objektname = "" Then
' MessageBox.Show("Objektname 1: " & Chr(13) & Objektname)
Else
' MessageBox.Show("Objektname 2: " & Chr(13) & Objektname)
If Objektliste.Contains(Objektname) Then Continue For
Objektliste.Add(Objektname)
Anzahl_Objekte = Anzahl_Objekte + 1
End If

Next

'MsgBox("Anzahl Objekte in Spalte A: " & Anzahl_Objekte)

iProperties.Value("Project", "Description") = InputListBox("Wähle ein Objekt", Objektliste, iProperties.Value("Project", "Description"), Title := "Auswahl Objekt", ListName := "Objektliste")
GewähltesObjekt = iProperties.Value("Project", "Description")

'MsgBox("Es wurde das Objekte ausgewählt: " & GewähltesObjekt)

If GewähltesObjekt = "Alle" Then
Startzeile = 3
Endzeile = Anzahl_Eigenschaften + 2
End If

'Ermittlung der Startzeile der Eigenschaften für das ausgewählte Objekt
For i = 1 To Anzahl_Eigenschaften
Dim Zelle_Ai As String = "A" & i ' Spalte A: Objektname
Objektname = GoExcel.CellValue(Zelle_Ai)

If Objektname = GewähltesObjekt Then
Startzeile = i
'MsgBox("Objekt: " & Objektname & vbCrLf & "Startzeile: " & Startzeile)
Exit For
End If
Next

'Ermittlung der Endzeile der Eigenschaften für das ausgewählte Objekt
For i = 1 To Anzahl_Eigenschaften
Dim Zelle_Ai As String = "A" & i ' Spalte A: Objektname
Objektname = GoExcel.CellValue(Zelle_Ai)

If Objektname = GewähltesObjekt Then
Endzeile = i
'MsgBox("Objekt: " & Objektname & vbCrLf & "Endzeile: " & Endzeile)
End If
Next

AnzahlEigenschaftenObjekt = Endzeile - Startzeile
'MsgBox("Startzeile: " & Startzeile & vbCrLf & "Endzeile: " & Endzeile & vbCrLf & "Anzahle Zeilen: " & AnzahlEigenschaftenObjekt)

'*********************************************************************
'Eigenschaften aus Tabelle lesen und in Bauteil / Baugruppe erstellen
'*********************************************************************

Nummer_Eigenschaft = 0
Erzeugte_Eigenschaft = 0
Zähler_benutzerparameter = 0
Erzeugter_Benutzerparameter = 0

Dim iCount As Integer
iCount = 1

'Für die Haupt-Baugruppe
If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Or ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then

For i = Startzeile To Endzeile
' ZeilenNr = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "=", i)
' Eigenschaftenname = GoExcel.CurrentRowValue("C")
' Wert = GoExcel.CurrentRowValue("Name")
' Datentyp = GoExcel.CurrentRowValue("Einheiten")
' Typ = GoExcel.CurrentRowValue("Typ")
' Beschreibung = GoExcel.CurrentRowValue("Beschreibung")

Dim Zelle_Ci As String = "C" & i ' Spalte C: Eigenschaftsname
Dim Zelle_Di As String = "D" & i ' Spalte D: Eigenscahftswert
Dim Zelle_Ii As String = "I" & i ' Spalte I: Einheit der Eigenschaft
Dim Zelle_Fi As String = "F" & i ' Spalte F: Datentyp der Eigenschaft
Dim Zelle_Hi As String = "H" & i ' Spalte H: Beschreibungatext der Eigenschaft bzw. des Eigenschaftswerts

Eigenschaftenname = GoExcel.CellValue(Zelle_Ci)
Wert = GoExcel.CellValue(Zelle_Di)
Datentyp = GoExcel.CellValue(Zelle_Ii)
Typ = GoExcel.CellValue(Zelle_Fi)
Beschreibung = GoExcel.CellValue(Zelle_Hi)

' MsgBox("i: " & i)

If Typ = "Eigenschaft" Then
' MsgBox("1. If-Then: Eigenschaft - Spalte Name:" & vbCrLf & vbCrLf & "Zeilennummer i: " & i & vbCrLf & "Eigenschaftenname: " & Eigenschaftenname & vbCrLf & "Wert: " & Wert & vbCrLf & "Beschreibung: " & Beschreibung)
Zähler_Eigenschaft = iPropertieCheck("", "Custom", Eigenschaftenname, "ND") 'Aufruf der Funktion "iPropertieCheck"
Erzeugte_Eigenschaft = Erzeugte_Eigenschaft + Zähler_Eigenschaft
Nummer_Eigenschaft = Nummer_Eigenschaft + 1
End If

If Typ = "Wert [Werteliste]" Then
' MsgBox("2. If-Then: Wert [Werteliste] - Spalte Name:" & vbCrLf & vbCrLf & "Zeilennummer i: " & i & vbCrLf & "Eigenschaftenname :" & Eigenschaftenname & vbCrLf & "Wert :" & Wert & vbCrLf & "Beschreibung: " & Beschreibung)
Zähler_Benutzerparameter = BenutzerParameterAnlegen(ThisApplication.ActiveDocument, i, Eigenschaftenname, Wert, Beschreibung, Eigenschaftentabelle) 'Aufruf der Funktion "BenutzerParameterAnlegen"
Erzeugter_Benutzerparameter = Erzeugter_Benutzerparameter + Zähler_Benutzerparameter
Nummer_Benutzerparameter = Nummer_Benutzerparameter + 1
End If
Next

End If

'Für jedes Bauteil und jede Unterbaugruppe in der Haupt-Baugruppe
If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
Dim oApp As Inventor.Application = ThisApplication
Dim oAssyDoc As Inventor.AssemblyDocument = oApp.ActiveDocument

For Each oSubDoc As Inventor.Document In oAssyDoc.AllReferencedDocuments

    If oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kPartDocumentObject Or oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kAssemblyDocumentObject Then

Try
'Wenn das Bauteil ein Inhaltcenter-Bauteil ist, dann überspringe das Bauteil
oCustomPropertySet = oSubDoc.PropertySets.Item("2DB9508F-CBA8-4714-ABE9-1A0EDB5B586C") 'ContentCenter in VBA
Exit Try
Catch
'Wenn es sich um ein iPart oder ein iAssembly handelt, dann überspringe das Bauteil
If oSubDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
Dim oPartDoc As PartDocument = DirectCast(oSubDoc,PartDocument)
If oPartDoc.ComponentDefinition.IsContentMember = True Then Continue For
If oPartDoc.ComponentDefinition.IsiPartMember = True Then Continue For
If oPartDoc.ComponentDefinition.IsiPartFactory = True Then Continue For
If oPartDoc.IsModifiable = False Then Continue For
End If

If oSubDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
Dim oAssDoc As AssemblyDocument = DirectCast(oSubDoc,AssemblyDocument)
If oAssDoc.ComponentDefinition.IsiAssemblyMember= True Then Continue For
If oAssDoc.ComponentDefinition.IsiAssemblyFactory = True Then Continue For
If oAssDoc.IsModifiable = False Then Continue For
End If

'Wenn das Bauteil ein "normales" Bauteil ist, dann erstelle die Eigenschaften
oCustomPropertySet = oSubDoc.PropertySets.Item("D5CDD505-2E9C-101B-9397-08002B2CF9AE") 'benutzerdefinierte iProperties

For i = Startzeile To Endzeile
' ZeilenNr = GoExcel.FindRow(Eigenschaftentabelle, "Tunnelbau", "Nummer", "=", i)
' Eigenschaftenname = GoExcel.CurrentRowValue("C")
' Wert = GoExcel.CurrentRowValue("Name")
' Datentyp = GoExcel.CurrentRowValue("Einheiten")
' Typ = GoExcel.CurrentRowValue("Typ")
' Beschreibung = GoExcel.CurrentRowValue("Beschreibung")

Dim Zelle_Ci As String = "C" & i ' Spalte C: Eigenschaftsname
Dim Zelle_Di As String = "D" & i ' Spalte D: Eigenscahftswert
Dim Zelle_Ii As String = "I" & i ' Spalte I: Einheit der Eigenschaft
Dim Zelle_Fi As String = "F" & i ' Spalte F: Datentyp der Eigenschaft
Dim Zelle_Hi As String = "H" & i ' Spalte H: Beschreibungatext der Eigenschaft bzw. des Eigenschaftswerts

Eigenschaftenname = GoExcel.CellValue(Zelle_Ci)
Wert = GoExcel.CellValue(Zelle_Di)
Datentyp = GoExcel.CellValue(Zelle_Ii)
Typ = GoExcel.CellValue(Zelle_Fi)
Beschreibung = GoExcel.CellValue(Zelle_Hi)

If Typ = "Eigenschaft" Then
'MsgBox("1. If-Then: Eigenschaft - Spalte Name:" & vbCrLf & "Zeilennummer i: " & i & vbCrLf & "Eigenschaftenname: " & Eigenschaftenname & vbCrLf & "Wert: " & Wert & vbCrLf & "Beschreibung: " & Beschreibung)
Zähler_Eigenschaft = iPropertieCheck(GetDisplayName(oSubDoc),"Custom", Eigenschaftenname, "ND") 'Aufruf der Funktion "iPropertieCheck"
Erzeugte_Eigenschaft = Erzeugte_Eigenschaft + Zähler_Eigenschaft
Nummer_Eigenschaft = Nummer_Eigenschaft + 1
End If

If Typ = "Wert [Werteliste]" Then
'MsgBox("2. If-Then: Wert [Werteliste] - Spalte Name:" & vbCrLf & "Zeilennummer i: " & i & vbCrLf & "Eigenschaftenname :" & Eigenschaftenname & vbCrLf & "Wert :" & Wert & vbCrLf & "Beschreibung: " & Beschreibung)
Zähler_benutzerparameter = BenutzerParameterAnlegen(oSubDoc, i, Eigenschaftenname, Wert, Beschreibung, Eigenschaftentabelle) 'Aufruf der Funktion "BenutzerParameterAnlegen"
Erzeugter_Benutzerparameter = Erzeugter_Benutzerparameter + Zähler_Benutzerparameter
Nummer_Benutzerparameter = Nummer_Benutzerparameter + 1
End If
Next
End Try
    End If

iCount = iCount + 1
Next
End If

MessageBox.Show("Es wurden alle fehlenden iProperties in den verbauten Baugruppen und Bauteilen angelegt." & Chr(13) & Chr(13) _
& "Es wurden in insgesamt " & iCount & " Bauteilen und Baugruppen die Eigenschaften erstellt." & Chr(13) & Chr(13) _
& "Es wurden insgesamt " & Nummer_Eigenschaft & " eindeutige Eigenschaften gelesen." & Chr(13) _
& "Es wurden in Summe " & Erzeugte_Eigenschaft & " neue Eigenschaften in den Bauteilen und Baugruppen angelegt." & Chr(13) _
& "Die restlichen Eigenschaften sind bereits vorhanden" & Chr(13) & Chr(13) & chr(13) _
& "Es wurden insgesamt " & Nummer_Benutzerparameter & " Benutzerparameter gelesen" & Chr(13) _
& "Es wurden in Summe " & Erzeugter_Benutzerparameter & " neue Benutzerparameter in den Bauteilen und Baugruppen angelegt." , "iPropertie", MessageBoxButtons.OK, MessageBoxIcon.Information)

End Sub

'########################################
'# Funktionen #
'########################################

'****************************************
'Funktion Prüfung iProperty und ergänzen
'****************************************

Private Function iPropertieCheck(Bauteilname As String, Reiter As String, Eigenschaft As String, Eigenschaftswert As String) As Integer
Try
iProp = iProperties.Value(Bauteilname, Reiter, Eigenschaft)

If Eigenschaft = "010_Eigentuemer" then
Eigenschaftswert = "DBI"
Else If Eigenschaft = "020_Autor" Then
Eigenschaftswert = "VP2ZB"
Else If Eigenschaft = "030_Projektnummer" Then
Eigenschaftswert = "G.016268527"
Else If Eigenschaft = "040_Bereich" Then
Eigenschaftswert = "01"
Else If Eigenschaft = "050_Vertragspartner" Then
Eigenschaftswert = "02"
Else If Eigenschaft = "060_Gewerk" Then
Eigenschaftswert = "32"
Else If Eigenschaft = "070_Bauwerk" Then
Eigenschaftswert = "SB"
Else If Eigenschaft = "Status" Then
Eigenschaftswert = "NBA"
End If

iProperties.Value(Bauteilname, Reiter, Eigenschaft) = Eigenschaftswert

Catch
' MessageBox.Show("Das iPropertie """ & Eigenschaft & """ wurde nicht gefunden." & vbLf & vbLf & "Das iPropertie """ & Eigenschaft & """ wird in der Datei angelegt." _
' & vbLf & vbLf & "Der Inhalt des iPropertie ist: " & Eigenschaftswert, "iPropertie", MessageBoxButtons.OK, MessageBoxIcon.Information)

If Eigenschaft = "010_Eigentuemer" then
Eigenschaftswert = "DBI"
Else If Eigenschaft = "020_Autor" Then
Eigenschaftswert = "VP2ZB"
Else If Eigenschaft = "030_Projektnummer" Then
Eigenschaftswert = "G.016268527"
Else If Eigenschaft = "040_Bereich" Then
Eigenschaftswert = "01"
Else If Eigenschaft = "050_Vertragspartner" Then
Eigenschaftswert = "02"
Else If Eigenschaft = "060_Gewerk" Then
Eigenschaftswert = "32"
Else If Eigenschaft = "070_Bauwerk" Then
Eigenschaftswert = "SB"
Else If Eigenschaft = "Status" Then
Eigenschaftswert = "NBA"
Else
Eigenschaftswert = "ND"
End If

iProperties.Value(Bauteilname, Reiter, Eigenschaft) = Eigenschaftswert

Zähler_Eigenschaft = 1
Return Zähler_Eigenschaft
End Try
End Function

'****************************************
'Funktion Benutzerparameter als Text-Parameter mit Multiauswahlliste erstellen
'****************************************

Private Function BenutzerParameterAnlegen(oDoc As Document, Zeile As Integer , Eigenschaft As String, Eigenschaftswert As String, Eigenschaftsbeschreibung As String, Tabellenname As String, Optional Bauteilname As String = "") As Integer
'Erstellen der Benutzerparameter
Dim Benutzerparameter As UserParameters
Benutzerparameter = oDoc.ComponentDefinition.Parameters.UserParameters
Benutzerparametername = "z_" & Eigenschaft
' MsgBox("Benutzerparametername: "  & Benutzerparametername)
Try
BenPara = Benutzerparameter.Item(Benutzerparametername)
' MsgBox("Benutzerparametername: " & Benutzerparametername & " ist vorhanden.")
MultiauswahllisteAnlegen(oDoc, Zeile, Eigenschaft, Eigenschaftswert, Eigenschaftsbeschreibung, Benutzerparametername, Tabellenname, Bauteilname) 'Aufruf der Funktion "MultiauswahllisteAnlegen"
Catch
' MessageBox.Show("Der Benutzerparameter """ & Benutzerparametername & """ wurde nicht gefunden." & vbLf & vbLf & "Der Benutzerparameter """ & Benutzerparametername & """ wird in der Datei angelegt." _
' & vbLf & vbLf & "Der Inhalt des Benutzerparameters ist: " & Eigenschaft, "Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)

BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits)
' MsgBox("Der Benutzerparametername: "  & Benutzerparametername & " wurde angelegt.")

MultiauswahllisteAnlegen(oDoc, Zeile, Eigenschaft, Eigenschaftswert, Eigenschaftsbeschreibung, Benutzerparametername, Tabellenname, Bauteilname) 'Aufruf der Funktion "MultiauswahllisteAnlegen"

Zähler_Benutzerparameter = 1
Return Zähler_Benutzerparameter
End Try
End Function

'****************************************
'Funktion Multiauswahlliste für Benutzerparameter erstellen
'****************************************

Private Function MultiauswahllisteAnlegen(oDoc As Document, Zeile As Integer , Eigenschaft As String, Eigenschaftswert As String, Eigenschaftsbeschreibung As String, Benutzerparametername As String, Tabellenname As String, Bauteilname As String) As Integer
'Erstellen der Mulitiauswahlliste
' MsgBox("Erstellung der Multiauswahlliste:" & vbCrLf & "Zeilennummer i: " & Zeile & Chr(13) & "Eigenschaftenname: " & Eigenschaft & vbCrLf & "Eigenschaftswert: " & Eigenschaftswert & vbCrLf & _
' "Eigenschaftsbeschreibung: " & Eigenschaftsbeschreibung & Chr(13) & "Eigenschaft: " & Benutzerparametername & vbCrLf & "Bauteilname: " & Bauteilname)

' die Zeile aktivieren, damit beim Erzeugen/Ändern der Multivalueliste der in DefaultIndex definierte Wert ausgewählt wird.
' MultiValue.SetValueOptions(True, DefaultIndex :=0)

Dim Liste As New ArrayList
If Bauteilname = "" Then
Liste = MultiValue.List(Benutzerparametername)
Else
Liste = MultiValue.List(Bauteilname, Benutzerparametername)
End If

If Eigenschaftsbeschreibung = "" Then
Eigenschaftsbeschreibung = "nd"
End If

If Liste.Contains(Eigenschaftsbeschreibung) Then
' nichts tun
Else
Liste.Add(Eigenschaftsbeschreibung)
If Bauteilname = "" Then
MultiValue.List(Benutzerparametername) = Liste
Else
MultiValue.List(Bauteilname, Benutzerparametername) = Liste
End If
End If

'Ausgabedialog zur Kontrolle - kann auskommentiert werden!
' MsgBox("Es wurde folgender Benutzerparameter mit einer Auswahlliste befüllt: " & Chr(13) & Benutzerparametername & Chr(13) & _
'   "Der Benutzerparameter enthält derzeit den Wert: " & Chr(13) & Parameter(Benutzerparametername))

Zähler_Benutzerparameter = 1
Return Zähler_Benutzerparameter

End Function

'****************************************
'Funktion Abfrage Anzeigename von Teilen
'****************************************
Private Function GetDisplayName(oTeil As Inventor.Document) As String
If oTeil.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
Return GetDisplayName(DirectCast(oTeil,Inventor.PartDocument))
Else
Return GetDisplayName(DirectCast(oTeil,Inventor.AssemblyDocument))
End If
End Function

'****************************************
'Funktion Abfrage Anzeigename von Bauteilen
'****************************************
Private Function GetDisplayName(oBauteil As Inventor.PartDocument) As String
If oBauteil.ComponentDefinition.IsModelStateMember = True Then
oBauteil = DirectCast(oBauteil.ComponentDefinition.FactoryDocument,Inventor.PartDocument)
End If
Return oBauteil.DisplayName
End Function

'****************************************
'Funktion Abfrage Anzeigename von Baugruppen
'****************************************
Private Function GetDisplayName(oBaugruppe As Inventor.AssemblyDocument) As String
If oBaugruppe.ComponentDefinition.IsModelStateMember = True Then
oBaugruppe = DirectCast(oBaugruppe.ComponentDefinition.FactoryDocument,Inventor.AssemblyDocument)
End If
Return oBaugruppe.DisplayName
End Function

---

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

---

Moin

Ändere biite in Zeile 274 den Code von

Code:

---

Zähler_benutzerparameter = BenutzerParameterAnlegen(oSubDoc, i, Eigenschaftenname, Wert, Beschreibung, Eigenschaftentabelle) 'Aufruf der Funktion "BenutzerParameterAnlegen"

---

in

Code:

---

Zähler_benutzerparameter = BenutzerParameterAnlegen(oSubDoc, i, Eigenschaftenname, Wert, Beschreibung, Eigenschaftentabelle, GetDisplayName(oSubDoc)) 'Aufruf der Funktion "BenutzerParameterAnlegen"

---

Die Bauteile und Unterbaugruppen müssen den Bauteilnamen mitliefern. Ansonsten wird in der Funktion BenutzerParameterAnlegen die Funktion MultiauswahllistenAnlegen ohne den Namen der Komponente aufgerufen. Das führt dazu, das die Funktion MultiauswahllistenAnlegen "meint" sie soll die Liste in der Hauptbaugruppe anlegen.

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

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

---

Hallo Ralf,
vielen, vielen Dank. Jetzt können wir eine Sekt aufmachen.
Nun funktioniert alles, wie ich es mir vorgestellt und gewünscht habe.
Ich hatte mir das so ungefähr gedacht, konnte es aber nicht umsetzen.

Nochmals danke für Deine Ausdauer und Unterstützung.

Schöne Grüße
Stephan

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