---

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

---

Modellgliederung_Skript.pdf

Hallo Ralf,

jetzt komme ich doch noch mal auf das Programm zurück.
Wir haben in den letzten Wochen damit intensiv gearbeitet und es angewendet. Nun sind uns aber noch ein paar Punkte aufgefallen, die wir gerne optimieren möchten. Ich weiß aber nicht, ob das grundsätzlich so möglich ist. Vielleicht kannst Du mir auf meine Fragen eine Antwort geben, bevor ich versuche das im Code umzusetzen.

Wir haben eine Hauptbaugruppe, in der Unterbaugruppen und Bauteile enthalten sind. In den Unterbaugruppen sind wiederum Bauteile enthalten.
Alle Bauteile sind aus einem Skelett-Bauteil, in dem die verschiedenen Volumenkörper modelliert sind, abgeleitet.
In dem Skelett sind wiederum Skizzen aus einem weiteren Bauteil abgeleitet.
Ich habe das mal versuch in einer Grafik darzustellen.

In den Baugruppen sollen nun nur die iProperties angelegt werden.
In den Bauteilen sollen sowohl die Benutzerparameter mit den Auswahllisten als auch die iProperties angelegt werden.
Allerdings soll dies nur in den "echten" Bauteilen geschehen und nicht in dem Skelett-Bauteil und dem Bauteil mit den Skizzenblöcken.

Kann man das im Code so abfangen / abfragen, dass das Einfügen von Benutzerparametern und iProperties nicht bis in Tiefe der Bauteile des Skeletts und das Bauteil mit den Skizzenblöcken erfolgt?

Der bisherige Code findet wirklich alle irgendwie verknüpften Bauteile und erstellt dort die Benutzerparameter und iProperties. Das ist uns aber zu weitreichend.

Könnte man eine Abfrage nach Teilen des Dateinamens (z.B. "Skelett" und "Regelquerschnitt") einbauen, die dann diese Bauteile nicht bearbeiten (ähnlich wie das mit den iParts/iAssemblies und Inhaltcenterdateien erfolgt?

Danke für Dein Antwort.
Liebe Grüße
Stephan

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

---

Moin

Ich würde unterhalb der Zeile

Code:

---

For Each oSubDoc As Inventor.Document In oAssyDoc.AllReferencedDocuments

---

prüfen ob der Dateiname eines der beiden Wörter enthält.
Also im einfachsten Fall mit

Code:

---

IF oSubDoc.FullFileName.ToUpper.Contains("SKELETT") OR oSubDoc.FullFileName.ToUpper.Contains("REGELQUERSCHNITT") THEN CONTINUE FOR

---

den ganzen Codeblock überspringen, wenn eines von beiden gefunden wird.

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

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

---

Hallo Ralf,
danke für die schnelle Antwort.
Der Ansatz ist mir dann auch in den Sinn gekommen, nachdem ich den Post geschrieben hatte - manchmal hilft es, wenn man über seine Probleme "spricht".
Allerdings hatte ich es etwas weiter unten im Code innerhalb der Try-Catch-Funktion mit einer IF-Then-Abfrage versucht und nur "Filename" und nicht "FullFileName.ToUpper" verwendet. Ich konnte dies gestern dann aber nicht mehr testen und weiß nicht, ob es wirklich funktioniert.

Ich schau mir das nochmals an und versuch auch Deinen Vorschlag.
Gruß Stephan

[Diese Nachricht wurde von FroSte am 16. Apr. 2025 editiert.]

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

---

Hallo Ralf,

danke nochmals für Deine Hilfe und den Vorschlag mit der Codezeile. das hat prima geklappt.

Jetzt habe ich aber noch eine Frage:
Ich möchte gerne in den Unterbaugruppen und deren Bauteile den Inhalt aus dem Property "Projekt - Beschreibung" bzw. "Project - Description" lesen. Leider funktioniert das nicht so , wie ich es unten gemacht habe. Es erscheint die Fehlermeldung das das Property nicht gefunden wird.
"Public member 'iPropertySets' on type 'AssemblyDocument' not found."

In der folgenden Zeile steckt der Wurm drin.

Code:

---

GeöffnetesObjekt = oSubDoc.iPropertySets("Project").Item("Description").Value

---

Ich habe schon verschiedene Varianten ausprobiert, aber immer mit dem selben Fehler.
Kannst Du mir sagen, wie die Zeile richtig aussehen muss?

Hier noch ein Ausschnitt aus dem gesamten Code (von oben), in dem ich die obige Zeile eingefügt habe.

Code:

---

'Wenn es sich um eine Baugruppe handelt, iAssemblies ausgelassen
    If 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 iAssembly handelt, dann überspringe die Baugruppe
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 die Bautgruppe eine "normale" Baugruppe ist, dann erstelle die Eigenschaften
oCustomPropertySet = oSubDoc.PropertySets.Item("D5CDD505-2E9C-101B-9397-08002B2CF9AE") 'benutzerdefinierte iProperties

'Inhalt aus iPropertie "Projekt - Beschreibung" auslesen, um zu ermitteln, umm welchen Datesatz / Bauteil es sich handelt
' GeöffnetesObjekt = iProperties.Value("Project", "Description")
GeöffnetesObjekt = oSubDoc.iPropertySets("Project").Item("Description").Value

MsgBox("Unterbaugruppe oder Bauteil in Hauptbaugruppe:" & vbCrLf & vbCrLf & "Geöffnetes Objekt: " & GeöffnetesObjekt)

---

Danke für Deine Hilfe.
Gruß Stephan

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

---

Moin, das wird daran liegen, dass es kein PropertySet "Project" gibt.
{32853F0F-3444-11D1-9E93-0060B03C1CA6} Design Tracking Properties

BTW - ich habe hier ein kleines Makro, dass mir alle iProps auflistet. So findet man das gesuchte vergleichsweise schnell.

Code:

---

Private Function ReadAlliProperties(doc As Document) As String
' liest alle iProperties aus
' Rückgabe in einem (großen) String
' Trennzeichen siehe Const d
'
' KraBBy 11.10.2018

    Const d As String = ";" 'Trennzeichen für Textausgabe

    Dim prop As Property
    Dim oPropSet As PropertySet
    'Set oPropSet = Doc.PropertySets.Item("Inventor User Defined Properties")
    Dim sTxt As String
   
    For Each oPropSet In doc.PropertySets  'Schleife durch alle PropSets
        ' Get the existing property, if it exists.
        Debug.Print "----------SET------- " & oPropSet.InternalName & " " & oPropSet.Name
        sTxt = sTxt & vbCrLf & "-----------SET-------" & d & oPropSet.InternalName & d & oPropSet.Name
        For Each prop In oPropSet
            On Error Resume Next
            Debug.Print prop.Name & vbTab & prop.DisplayName & vbTab & prop.value
            sTxt = sTxt & vbCrLf _
                    & prop.Name & d & prop.DisplayName & d & prop.value
            On Error GoTo 0 'setzt auch Err zurück
        Next 'prop
    Next 'propSet
   
    'Rückgabewert
    ReadAlliProperties = sTxt
   
    'Aufräumen (ergänzt)
    On Error GoTo 0
    Set oPropSet = Nothing
    Set prop = Nothing
End Function

---

------------------
Gruß KraBBy

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

---

Hi KraBBy,
vielen Dank für Deinen Hinweis.
Das PropertySet muss es eigentlich geben, denn es ist ja ein System-Property von Inventor. Mit dem folgenden Zeile kann ich darauf zugreifen, bekomme dann aber nur die Info aus der Hauptbaugruppe und nicht aus der Unterbaugruppe oder den Bauteilen in der Hauptbaugruppe bzw. Unterbaugruppe.

Code:

---

GeöffnetesObjekt = iProperties.Value("Project", "Description")

---

Ich werde nachher mal Dein Macro ausprobieren um zu sehen, was für iProps es gibt.

Gruß Stephan

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

---

Zitat:

---

Original erstellt von FroSte:
[...] Mit dem folgenden Zeile kann ich darauf zugreifen, bekomme dann aber nur die Info aus der Hauptbaugruppe und nicht aus der Unterbaugruppe oder den Bauteilen in der Hauptbaugruppe bzw. Unterbaugruppe.

Code:

---

GeöffnetesObjekt = iProperties.Value("Project", "Description")

---

---

In der Form von iProperties.Value() gibt es auch eine Syntax für Komponenten
iProperties.Value Property (Object, String, String)
Das wird auch funktionieren. Als Object muss die Komponente angegeben werden.

Das mit den PropertySets ist anders aufgebaut - das sind aus API-Sicht unterschiedliche Objekte - deshalb werden die Namen der PropSets unterschiedlich benutzt.

------------------
Gruß KraBBy

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

---

Hi KraBBy,

vielen Dank. Das war der richtige Hinweis. Jetzt klappt es.
Hier die entsprechenden Code-Zeilen:

Code:

---

GeöffnetesObjekt = iProperties.Value(GetDisplayName(oSubDoc), "Project", "Description")              'Inhalt aus dem iProperty "Projekt - Beschreibung" lesen
GeöffnetesObjekt_130 = iProperties.Value(GetDisplayName(oSubDoc), "Custom", "z_Matchkey_130")        'Inhalt aus dem benutzerdefinierten iProperty "z_Matchkey_130" lesen

---

Gruß Stephan

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

---

Hallo Ralf,

ich schlage mich schon wieder Tage und Nächte mit einem Problem herum, daas ich in meinem Programm habe. Ich komme einfach nicht weiter.

Das Problem ist folgendes:
Ich habe in den Bauteilen einer Baugruppe und den Bauteilen von Unterbaugruppen Benutzerparameter mit Multi Value-Listen angelegt sowie bestimmte Werte ausgewählt.
Nun möchte ich die Ausgewählten "Werte" in den Benutzerparametern "Übersetzen" und in entsprechende iProperties schreiben. Die Übersetzungstabelle liegt als Excel vor.

Ich habe ein Skript erstellt, das das genua macht was ich möchte, wenn ich es in einem einzelnen Bauteil direkt ausführe.

Wenn ich den Code allerdings versuche in mein Skript für die Baugruppen zu integrieren, komme ich nicht weiter.
Das Problem liegt darin, dass ich in den Beuteilen nicht auf die ausgewählten Werte in den Benutzerparameterzugreifen kann, sondern immer nur den ersten Wert der Multi Value-Liste bekomme.

Hier ist ein Auszug aus dem gesamten Programm (siehe weiter oben):

Code:

---

.
.
.
.

'----------------------------------------------------------------
'Für jedes Bauteil und jede Unterbaugruppe in der Haupt-Baugruppe
'In den Unterbaugruppen und deren Bauteile bzw. den Bauteilen in der Hauptbaugruppe der VKL werden alle Benutzerparameter und iProperties entsprechend der Exceltabelle im Tabellenblatt des Bauteils aufgeführten Merkmale angelegt
'Die Auswahl ist in der Exceltabelle in dem entsprechenden Tabellenblatt des Objektes definiert
'----------------------------------------------------------------
' If Frage_Unterbaugruppen = vbNo ' Wird nur ausgeführt, wenn die Abfrage, ob auch in den Unterbaugruppen und deren Bauteile iProperties und Benutzerparameter eingefügt werden sollen, mit "Nein" beantortet wurde


'------in allen Bauteilen alle Benutzerparameter anlegen und Auswahl treffen sowie alle Eigenschaften mit leerem Inhalt erstellen. Das Bauteil steht in dem iProperty "Beschreibung" und "z_Matckkey_130" und "z_Matckkey_140".---------------------------------
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
'MsgBox("Name Unterbaugruppe oder Bauteil: " & oSubDoc.FullFileName)

'Wenn bei der Unterbaugruppe oder beim Bauteil im Dateiname "Skelett" oder "REGELQUERSCHNITT" oder "_RQ_" enthalten ist, werden diese Bauteile und Baugruppen ausgelassen und nicht bearbeitet
If oSubDoc.FullFileName.ToUpper.Contains("SKELETT") _
Or oSubDoc.FullFileName.ToUpper.Contains("REGELQUERSCHNITT") _
Or oSubDoc.FullFileName.ToUpper.Contains("_RQ_") Then Continue For

    If oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kPartDocumentObject Or oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kAssemblyDocumentObject Then
'    If oSubDoc.DocumentType = kPartDocumentObject Then
'    If oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kPartDocumentObject Then
'MsgBox("Kontrolle: Dies ist ein Bauteil - " & oSubDoc.FullFileName)
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 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
'Wenn es sich um ein iAssembly handelt, dann überspringe die Baugruppe
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

'Inhalt aus iPropertie "Projekt - Beschreibung" auslesen, um zu ermitteln, umm welchen Datesatz / Bauteil es sich handelt
GeöffnetesObjekt = iProperties.Value(GetDisplayName(oSubDoc), "Project", "Description") 'Inhalt aus dem iProperty "Projekt - Beschreibung" lesen
GeöffnetesObjekt_130 = iProperties.Value(GetDisplayName(oSubDoc), "Custom", "z_Matchkey_130") 'Inhalt aus dem benutzerdefinierten iProperty "z_Matchkey_130" lesen
GeöffnetesObjekt_140 = iProperties.Value(GetDisplayName(oSubDoc), "Custom", "z_Matchkey_140") 'Inhalt aus dem benutzerdefinierten iProperty "z_Matchkey_140" lesen

.
.
.
.
.
.

'--------------------
'In Bauteilen die Werte der Parameter in Properties übernehmen
If oSubDoc.DocumentType = kPartDocumentObject Then
Dim SubDocParam As Parameter
For Each SubDocParam In oSubDoc.ComponentDefinition.Parameters
SubDocParam.ExposedAsProperty = False ' Benutzerparameter als Exportparameter ausschalten
ParamName = SubDocParam.Name ' Name des Benutzerparameters
ParamInhalt = SubDocParam.Value ' Wert/Gleichung des Benutzerparametrs
If SubDocParam.name.contains("DBSet") Then
SubDocParam.ExposedAsProperty = True ' Benutzerparameter als Exportparameter einschalten

MsgBox("Dokument: " & GetDisplayName(oSubDoc) & vbCrLf & vbCrLf & "Geöffnetes Objekt: " & GeöffnetesObjekt & vbCrLf & "Parametername: " & ParamName & vbCrLf & vbCrLf & "Parameterwert: " & ParamInhalt)

MultiauswahllisteAuswahl(oSubDoc, Startzeile_Bauteilblatt, Endzeile_Bauteilblatt, Eigenschaftentabelle, Tabellenblatt_Name, GeöffnetesObjekt, ParamName, ParamInhalt, GeöffnetesObjekt)
End If
Next
End If

End Try
    End If

iCount = iCount + 1
Next
End If

' End If
.
.
.
.
.

---

Mit den beiden Zeilen erhalte ich den Korrekten Parametername, aber nicht den Wert, der in dem Parameter steht, sondern den ersten Wert der Auswahlliste in dem Parameter.

Code:

---

ParamName = SubDocParam.Name ' Name des Benutzerparameters
ParamInhalt = SubDocParam.Value ' Wert/Gleichung des Benutzerparametrs

---

Hast Du eine Idee, woran das liegen könnte?
Ich habe jetzt schon so viel ausprobiert, aber immer ohne Erfolg.

Vielen Dank für Deine Unterstützung.

Gruß Stephan

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

---

Moin

Kurze Frage vorweg, hast du Modellzustände im Einsatz?

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

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

---

Hallo,

ausgeschlafen bin ich nun eine Erkenntnis weiter. Der Hund liegt an einer ganz anderen Stelle begraben. Die im vorherigen Post angegebene Code ist korrekt und tut was er soll.

Das Problem wird weiter oben im Code (hier nicht abgebildet) verursacht. Ich lösche einmal alle Benutzerparameter bevor ich sie wieder mit neuen Inhalten anlege. Und von diesen neu angelegten Benutzerparameter scheint er dann die Auswahl / den Inhalt nicht mehr richtig zu lesen.
Mal schauen, ob ich das auch noch herausfinde.

Danke aber trotzdem für eventuell bereits angestrengtes Nachdenken.

Gruß Stephan

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

---

Moin

Dann zeig doch mal wie du die Multivalue Parameter anlegst. Wenn ich mich richtig erinnere, kann man eine Liste zuweisen aber der aktuelle Value des Parameters bleibt unverändert.

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

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

---

Hallo Ralf,
in einzelnen Bauteilen oder Baugruppe können Modellzustände vorhanden sein. Aber eigentlich wird immer der Primärzustand verwendet.

Müsste man das auch abfragen bzw. definieren, in welchem Modellzustand die Benutzerparameter angelegt werden sollen?
Wie würde das dann aussehen?

Danke für die Rückmeldung.
Gruß Stephan

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

---

Moin

Ja, Parameter sind in Modellzuständen enthalten. Angelegt werden sie wie bisher. Meines Wissens erstellt Inventor sie automatisch im FactoryDocument mit dem initialen Value, der für alle Modelstates gilt. Man kann anschließend im jeweiligen Memberdocument den Value ändern, der dann nur für diesen Modelstate gilt. In Baugruppen muss dann für jedes Exemplar (Occurrence) der gewünschte Modelstate aktiviert werden.
Hat der Parameter in allen Modelstates den gleichen Value, wird man keinen Unterschied feststellen.

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

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

---

Projektanforderungen_fur_Inventor.zip CAD-Forum.zip

Hallo Ralf,

Das ist die Stelle, an der ich die Funktion zum Löschen der Benutzerparameter in den Bauteilen aufrufe.
Das "Suchkriterium" definiert mir die Benutzerparameter, die gelöscht werden sollen, wenn dieses im Namen enthalten ist.
Verwende ich das Suchkriterium "DBSet" (im Moment auskommentiert), dann werden alle entsprechenden Benutzerparameter gelöscht und auch wieder neu angelegt sowie die Werte in den Auswahllisten korrekt eingetragen. Allerdings ist die "Übersetzung" für die ausgewählten Begriffe in den iProperties nicht korrekt. Dort werden die für die "Übersetzungen" dann jeweils die ersten Begriffe in den Auswahllisten verwendet und nicht die tatsächlich eingetragenen Begriffe.

Das Suchkriterium "nicht Löschen" ist die Notlösung. Es gibt keine Benutzerparameter, die dieses enthalten und werden somit auch nicht gelöscht. Damit klappt dann alles wie es sein soll. Die Benutzerparameter erhalten auch die gewünschte Auswahl und in den iProperties werden die passenden "Übersetzungen" verwendet.

Code:

---

'löschen der vorhandenen Benutzerparameter und der benutzerdefinierten Properties, die mit "DBSet" beginnen
Dim Suchkriterium As String
Dim Ausschlusskrit As String
If oSubDoc.DocumentType = kPartDocumentObject Then
Suchkriterium = "nicht Löschen"
' Suchkriterium = "DBSet"
Ausschlusskrit = "Flaeche"
Else If oSubDoc.DocumentType = kAssemblyDocumentObject Then
Suchkriterium = "nicht Löschen"
' Suchkriterium = "DBSet"
End If

'Benutzerparameter
DeleteUserParameters(oSubDoc, Suchkriterium, Ausschlusskrit) 'Programmaufruf zum Löschen der Benutzerparameter
' DeleteUserParameters(ThisApplication.ActiveDocument, Suchkriterium) 'Programmaufruf zum Löschen der Benutzerparameter
'MessageBox.Show("Alle benutzerdefinierten Parameter mit ""DBSet"" wurden gelöscht.", "Erfolg", MessageBoxButtons.OK, MessageBoxIcon.Information)

'benutzerdefinierte Properties
DeleteUserProperties(oSubDoc, Suchkriterium) 'Programmaufruf zum Löschen der benutzerdefinierten Properties
' DeleteUserProperties(ThisApplication.ActiveDocument, Suchkriterium) 'Programmaufruf zum Löschen der benutzerdefinierten Properties
'MessageBox.Show("Alle benutzerdefinierten Parameter mit ""DBSet"" wurden gelöscht.", "Erfolg", MessageBoxButtons.OK, MessageBoxIcon.Information)

---

Nachfolgende der gesamte Code. An der fett hervorgehobenen Stelle befindet sich der obige Auszug.
Ein kleines Beispielmodell und die Exceltabelle habe ich beigelegt.

Code:

---

'####################################
' Hauptprogramm
'####################################
Sub Main()

Dim i As Integer
Dim Nummer_Eigenschaft As Integer
Dim Startzeit As String
Dim Endzeit As String
Dim Dauer As String
Dim Titel As String
Dim Beschr As String

Startzeit = DateTime.Now.ToShortTimeString

'********************************************************************
'Prüfung, ob ein Bauteil oder eine Baugruppe geöffnet und aktiv ist
'********************************************************************
If Not ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
MessageBox.Show("Die aktive Datei ist keine Baugruppe!" & Chr(13) & Chr(13) & "Eine Baugruppe (*.iam) muss geöffnet bzw. aktiv sein."& Chr(13) & Chr(13) & Chr(13) & Chr(13) & "Starten Sie das Programm in der Hauptbaugruppe der Vortriebsklasse!!!!", "Baugruppe Vortriebsklasse")
Exit Sub
End If

Titel = iProperties.Value("Summary", "Title") 'Inhalt im Property "Titel"
Beschr = iProperties.Value("Project", "Description") 'Inhalt im Property "Titel"

If Titel.Contains("Vortriebsklasse") = False And Beschr.Contains("VKL") = False Then
MessageBox.Show("Die aktive Datei ist nicht die Hauptbaugruppe der Vorriebsklasse" & Chr(13) & "oder im Titel und der Beschreibung ist nicht die Vortriebsklasse angegeben!" & Chr(13) & Chr(13) & _
"Es muss die Hauptbaugruppe der VKL geöffnet werden." & Chr(13) & Chr(13) & Chr(13) & Chr(13) & "Starten Sie das Programm in der Hauptbaugruppe der Vortriebsklasse!!!!", "Baugruppe Vortriebsklasse")
Exit Sub
End If

'********************************************************************
'Hinweis zum Programm
'********************************************************************
MessageBox.Show("Das Programm fügt in allen Bauteilen der Hauptbaugruppe, allen Unterbaugruppen und allen Unterbauteilen die erforderlichen Merkmale / Benutzerparameter und deren Attribute ein." & vbCrLf &  _
"Die Erforderlichen Daten werden aus einer Excecltabelle mit der aufbereiteten Datenstruktur und den ausgewählten Werten (Attribute) gelesen." & vbCrLf & _
"Die Laufzeit beträgt ca. 10 - 20 Minuten je Vortriebsklasse (abhängig von der Anzahl der Bauteile)", "Dialog Info Laufzeit")

'**********************************************************************************************************
'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.InitialDirectory = "C:\z_Vault\CAD\DL23075801-DE-Pfaffensteigtunnel\BIM"
oFileDlg_Tabelle.FileName = "C:\z_Vault\CAD\DL23075801-DE-Pfaffensteigtunnel\BIM\Gäubahn-Nord_Projektanforderungen_für_Inventor.xlsx"
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 oder gefunden. 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 = 50000

'Anzahl der Zeilen im Tabellenblatt "Tunnelbau"
Anzahl_Eigenschaften = GoExcel.CellValues(Eigenschaftentabelle, "Tunnelbau", "F3", "F" & Zeilen_Tabelle).Count
Anzahl_Zeilen = Anzahl_Eigenschaften + 2

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

' MessageBox.Show("In der ausgewählten Tabelle ist im Tabellenblatt Tunnelbau 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 Eigenschaften gelesen werden soll
'*********************************************************************

'Anzahl der Bauteile mit Werteliste im Tabellenblatt "Liste-Bauteile"
Dim DatensatzValues As ArrayList=GoExcel.CellValues(Eigenschaftentabelle, "Liste-Bauteile", "C2", "C100")
Dim Bauteil_130_Values As ArrayList = GoExcel.CellValues(Eigenschaftentabelle, "Liste-Bauteile", "D2", "D100")
Dim Bauteil_140_Values As ArrayList = GoExcel.CellValues(Eigenschaftentabelle, "Liste-Bauteile", "E2", "E100")
Dim TabName As New ArrayList
Dim Anzahl_Datensatz As Integer = DatensatzValues.Count
Dim Anzahl_Bauteil_130 As Integer = Bauteil_130_Values.Count
Dim Anzahl_Bauteil_140 As Integer = Bauteil_140_Values.Count
Dim Bauteil_130 As String
Dim Bauteil_140 As String

Dim Anzahl_Objekte As Integer
Dim Objektname As String
Dim Objektliste As New ArrayList
Dim Matchky_130_Array As New ArrayList
Dim Matchky_140_Array As New ArrayList
Dim Startzeile As Integer
Dim Endzeile As Integer
Dim Startzeile_Bauteilblatt As Integer
Dim Endzeile_Bauteilblatt As Integer
Dim AnzahlEigenschaftenObjekt As Integer

'Erstellung der Objektliste als Array-Liste mit den Objekten aus dem Tabellenblatt "Liste-Bauteile"
Objektliste.Add("Alle") 'In Array-Liste wird das Element "Alle" als erstes Element eingefügt
Matchky_130_Array.Add("Alle") 'In Array-Liste wird das Element "Alle" als erstes Element eingefügt
Matchky_140_Array.Add("Alle") 'In Array-Liste wird das Element "Alle" als erstes Element eingefügt

For i = 0 To Anzahl_Datensatz-1
Objektname = DatensatzValues(i)
Bauteil_130 = Bauteil_130_Values(i)
Bauteil_140 = Bauteil_140_Values(i)
SheetName = Left(Objektname & "-" & Bauteil_130 & "-" & Bauteil_140, 31) 'maximale Länge der Tabellenblätter in Excel auf 31 Zeichen begrenzt
TabName.Add(SheetName)

' MessageBox.Show("In der ausgewählten Tabelle ist im Tabellenblatt ""Liste-Bauteile"" folgende Anzahl an Datensätze enthalten:" & Chr(13) & Anzahl_Datensatz & Chr(13) & _
' "und folgende Anzahl Bauteile / Matchkey_130 enthalten: " & Anzahl_Bauteil_130 & Chr(13) & _
' "und folgende Anzahl Bauteile / Matchkey_140 enthalten: " & Anzahl_Bauteil_140 & Chr(13) & Chr(13) & _
' "Das Array-Element " & i & " enthält den Datensatz: " & Objektname & Chr(13) & _
' "Das Array-Element " & i & " enthält das Bauteil / Matchkey_130 : " & Bauteil_130 & Chr(13) & _
' "Das Array-Element " & i & " enthält das Bauteil / Matchkey_140 : " & Bauteil_140 & Chr(13) & Chr(13) & _
' "Der Tabellenblattname lautet: " & TabName(i) & Chr(13) & Chr(13) & _
' Chr(13) & Chr(13) & Eigenschaftentabelle, "Dialog Anzahl Zeilen", MessageBoxButtons.OK, MessageBoxIcon.Information)

If Objektliste.Contains(Objektname) Then
Continue For 'wenn der Objektname bereits in der Array-Liste vorhanden, dann überspringe dieses
Else
Objektliste.Add(Objektname) 'Objektname der Array-Liste hinzufügen
Anzahl_Objekte = Anzahl_Objekte + 1
End If

If Matchky_130_Array.Contains(Bauteil_130) Then
Continue For 'wenn der Objektname bereits in der Array-Liste vorhanden, dann überspringe dieses
Else
Matchky_130_Array.Add(Bauteil_130) 'Objektname der Array-Liste hinzufügen
End If

If Matchky_140_Array.Contains(Bauteil_140) Then
Continue For 'wenn der Objektname bereits in der Array-Liste vorhanden, dann überspringe dieses
Else
Matchky_140_Array.Add(Bauteil_140) 'Objektname der Array-Liste hinzufügen
End If

Next

Dim Objektanzahl As Integer = Objektliste.Count

'MsgBox("Anzahl Objekte in Objekteliste (Zähler): " & Anzahl_Objekte & vbCrLf & Anzahl Objekte in Objekteliste (Array-Liste): " & Objektanzahl)

'*********************************************************************
'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 geöffnete Hauptbaugruppe der VKL
'In der Hauptbaugruppe der VKL werden alle Benutzerparameter mit Auswahllisten und iProperties für alle Bauteile/Objekte entsprechend der Exceltabelle im Tabellenblatt "Liste-Bauteile" angelegt.
'Die Daten werden aus dem tabellenbaltt "Tunnelbau" gelesen.
'In der Hauptbaugruppe der VKL muss die entsrechenden Benutzerparameter ausgewählt werden.
'---------------------------
Dim BlattnameTunnel As String
BlattnameTunnel = "Tunnelbau"

' If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Or ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
If ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then

'löschen der vorhandenen Benutzerparameter und der benutzerdefinierten Properties in der Hauptbaugruppe, die mit "DBSet" beginnen
Dim Suchkriterium As String
Dim Ausschlusskrit As String
Suchkriterium = "DBSet"
Ausschlusskrit = "Flaeche"

'Benutzerparameter - alle Benutzerparameter mit "DBSet" werden gelöscht, außer die benutzerparameter mit "Fläche", da sonst die Oberflächenparameter nicht mehr verwendet und damit nicht mehr in das Bauteil abgeleitet werden
DeleteUserParameters(ThisApplication.ActiveDocument, Suchkriterium, Ausschlusskrit) 'Programmaufruf zum Löschen der Benutzerparameter
'MessageBox.Show("Alle benutzerdefinierten Parameter mit ""DBSet"" wurden gelöscht.", "Erfolg", MessageBoxButtons.OK, MessageBoxIcon.Information)

'benutzerdefinierte Properties
DeleteUserProperties(ThisApplication.ActiveDocument, Suchkriterium) 'Programmaufruf zum Löschen der benutzerdefinierten Properties
'MessageBox.Show("Alle benutzerdefinierten Parameter mit ""DBSet"" wurden gelöscht.", "Erfolg", MessageBoxButtons.OK, MessageBoxIcon.Information)

'Schleife über alle Bauteile in der Baugruppe
For z = 1 To Objektanzahl-1
Objekt = Objektliste(z)

' MsgBox("Objekt: " & Objekt & vbCrLf & "Eigenschaftentabelle: " & Eigenschaftentabelle & vbCrLf & "Anzahle Zeilen: " & Anzahl_Zeilen)

Startzeile = ErmittlungStarzeile(Anzahl_Zeilen, Eigenschaftentabelle,  "Tunnelbau", Objekt)
Endzeile = ErmittlungEndzeile(Anzahl_Zeilen, Eigenschaftentabelle,  "Tunnelbau", Objekt)

AnzahlEigenschaftenObjekt = Endzeile - Startzeile
If AnzahlEigenschaftenObjekt = 0 Then
MsgBox("Hauptbaugruppe:" & vbCrLf & vbCrLf & "Objekt: " & Objekt & vbCrLf & "Eigenschaftentabelle: " & Eigenschaftentabelle & vbCrLf & _
"Startzeile: " & Startzeile & vbCrLf & "Endzeile: " & Endzeile & vbCrLf & "Anzahle Zeilen: " & AnzahlEigenschaftenObjekt & vbCrLf & vbCrLf & _
"Das Programm wird beendet")
Exit Sub
End If

'Schleife über alle Merkmale des jeweiligen Bauteils
For i = Startzeile To Endzeile
Dim Zelle_Bi As String = "B" & i ' Spalte B: Propertieset
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

Try
Propertieset = GoExcel.CellValue(Eigenschaftentabelle, "Tunnelbau", Zelle_Bi)
Eigenschaftenname = GoExcel.CellValue(Eigenschaftentabelle, "Tunnelbau", Zelle_Ci)
Wert = GoExcel.CellValue(Eigenschaftentabelle, "Tunnelbau", Zelle_Di)
Einheit = GoExcel.CellValue(Eigenschaftentabelle, "Tunnelbau", Zelle_Ii)
Typ = GoExcel.CellValue(Eigenschaftentabelle, "Tunnelbau", Zelle_Fi)
Beschreibung = GoExcel.CellValue(Eigenschaftentabelle, "Tunnelbau", Zelle_Hi)
Catch
MsgBox("Bauteil in Unterbaugruppe:" & vbCrLf & vbCrLf & "Dateiname: " & FullFileName & vbCrLf & vbCrLf & _
"Anzeigename: " & DisplayName & vbCrLf & vbCrLf & _
"Geöffnetes Objekt: " & GeöffnetesObjekt & vbCrLf & _
"Geöffnetes Objekt 130: " & GeöffnetesObjekt_130 & vbCrLf & _
"Geöffnetes Objekt 140: " & GeöffnetesObjekt_140 & vbCrLf & _
"Eigenschaftentabelle: " & Eigenschaftentabelle & vbCrLf & vbCrLf & _
"Startzeile: " & Startzeile & vbCrLf & "Endzeile: " & Endzeile & vbCrLf & "Anzahle Zeilen: " & AnzahlEigenschaftenObjekt & vbCrLf & "Zeilennummer: " & i)
End Try


' MsgBox("i: " & i)

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

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

End If
Next

Next

'--------------------
'Übernahme der Vortriebsklasse in den Benutzerpasrameter (aus dem Titel) und die Properties (aus der Beschreibung)
Dim param As Parameter
Dim Vortriebsklasse As String
Dim VKL As String
Dim BenParamVKL As String
Dim iPropVKL As String

Vortriebsklasse = iProperties.Value("Summary", "Title") 'Inhalt im Property "Titel" = Parameterwert Auswahlliste
VKL = iProperties.Value("Project", "Description") 'Inhalt im Property "Beschreibung" = Propertry-Wert Abkürzung

For Each param In ThisApplication.ActiveDocument.ComponentDefinition.Parameters
ParamName = param.Name ' Name des Benutzerparameters in der Baugruppe

BenParamVKL = ParamName
L = Len(ParamName)
iPropVKL = Right(ParamName, L-2)
'MessageBox.Show("Properties: " & vbCrLf & "Titel: " & Vortriebsklasse & vbCrLf & "Beschreibung Auswahlliste: " & Vortriebsklasse & vbCrLf & "Abkürzung zur Beschreibung: " & VKL & vbCrLf & "BenParamVKL: " & BenParamVKL & vbCrLf & "iPropVKL: " & iPropVKL)
If ParamName IsNot Nothing Then
If MultiValue.List(ThisApplication.ActiveDocument, ParamName).Contains(Vortriebsklasse) = True Then
' If MultiValue.List(ThisApplication.ActiveDocument, BenParamVKL).Contains(Vortriebsklasse) Then
'Wert ist gültig
'MessageBox.Show("Der Wert """ & Vortriebsklasse & """ ist für den Benutzerparameter " & ParamName & " gültig!")
Try
Parameter(ThisApplication.ActiveDocument, ParamName) = Vortriebsklasse 'Eintragen des Werts "Vortriebsklasse" in den Parameter "BenParamVKL" zu
iProperties.Value(ThisApplication.ActiveDocument, "Custom", iPropVKL) = VKL
Catch
MessageBox.Show("Fehler beim Auswählen der Vortriebsklasse in den Benutzerparametern." & vbCrLf & "Bitte die Eingaben in den Parametern ""Titel"" und in ""Bezeichnung"" überprüfen.")
End Try
Else
'Wert ist ungültig
'MessageBox.Show("Der Wert """ & Vortriebsklasse & """ ist für den Benutzerparameter " & BenParamVKL & " ungültig!")
End If
If BenParamVKL.Contains(BenParamVKL) Then
param.ExposedAsProperty = False ' Benutzerparameter als Exportparameter ausschalten
param.ExposedAsProperty = True ' Benutzerparameter als Exportparameter einschalten
End If
Else
    MessageBox.Show("Auswahl bereits getroffen.")
End If
Next

End If

'----------------------------------------------------------------
'Für jedes Bauteil und jede Unterbaugruppe in der Haupt-Baugruppe
'In den Unterbaugruppen und deren Bauteile bzw. den Bauteilen in der Hauptbaugruppe der VKL werden alle Benutzerparameter und iProperties entsprechend der Exceltabelle im Tabellenblatt des Bauteils aufgeführten Merkmale angelegt
'Die Auswahl ist in der Exceltabelle in dem entsprechenden Tabellenblatt des Objektes definiert
'----------------------------------------------------------------
' If Frage_Unterbaugruppen = vbNo ' Wird nur ausgeführt, wenn die Abfrage, ob auch in den Unterbaugruppen und deren Bauteile iProperties und Benutzerparameter eingefügt werden sollen, mit "Nein" beantortet wurde


'------in allen Bauteilen alle Benutzerparameter anlegen und Auswahl treffen sowie alle Eigenschaften mit leerem Inhalt erstellen. Das Bauteil steht in dem iProperty "Beschreibung" und "z_Matckkey_130" und "z_Matckkey_140".---------------------------------
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
'MsgBox("Name Unterbaugruppe oder Bauteil: " & oSubDoc.FullFileName)

'Wenn bei der Unterbaugruppe oder beim Bauteil im Dateiname "Skelett" oder "REGELQUERSCHNITT" oder "_RQ_" enthalten ist, werden diese Bauteile und Baugruppen ausgelassen und nicht bearbeitet
If oSubDoc.FullFileName.ToUpper.Contains("SKELETT") _
Or oSubDoc.FullFileName.ToUpper.Contains("REGELQUERSCHNITT") _
Or oSubDoc.FullFileName.ToUpper.Contains("_RQ_") Then Continue For

    If oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kPartDocumentObject Or oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kAssemblyDocumentObject Then
'    If oSubDoc.DocumentType = kPartDocumentObject Then
'    If oAssyDoc.AllReferencedDocuments.Item(iCount).DocumentType = kPartDocumentObject Then
'MsgBox("Kontrolle: Dies ist ein Bauteil - " & oSubDoc.FullFileName)
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 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
'Wenn es sich um ein iAssembly handelt, dann überspringe die Baugruppe
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

'Inhalt aus iPropertie "Projekt - Beschreibung" auslesen, um zu ermitteln, umm welchen Datesatz / Bauteil es sich handelt
GeöffnetesObjekt = iProperties.Value(GetDisplayName(oSubDoc), "Project", "Description") 'Inhalt aus dem iProperty "Projekt - Beschreibung" lesen
GeöffnetesObjekt_130 = iProperties.Value(GetDisplayName(oSubDoc), "Custom", "z_Matchkey_130") 'Inhalt aus dem benutzerdefinierten iProperty "z_Matchkey_130" lesen
GeöffnetesObjekt_140 = iProperties.Value(GetDisplayName(oSubDoc), "Custom", "z_Matchkey_140") 'Inhalt aus dem benutzerdefinierten iProperty "z_Matchkey_140" lesen


Tabellenblatt_Name = Left(GeöffnetesObjekt & "-" & GeöffnetesObjekt_130 & "-" & GeöffnetesObjekt_140, 31) 'maximale Länge der Tabellenblätter in Excel auf 31 Zeichen begrenzt

Startzeile = ErmittlungStarzeile(Anzahl_Zeilen, Eigenschaftentabelle,  "Tunnelbau", GeöffnetesObjekt)
Endzeile = ErmittlungEndzeile(Anzahl_Zeilen, Eigenschaftentabelle,  "Tunnelbau", GeöffnetesObjekt)

AnzahlEigenschaftenObjekt = Endzeile - Startzeile
'MsgBox("Kontrolle: Unterbaugruppe oder Bauteil in Hauptbaugruppe:" & vbCrLf & vbCrLf & "Geöffnetes Objekt: " & GeöffnetesObjekt & vbCrLf & "Eigenschaftentabelle: " & Eigenschaftentabelle  & vbCrLf & "Startzeile: " & Startzeile & vbCrLf & "Endzeile: " & Endzeile & vbCrLf & "Anzahle Zeilen: " & AnzahlEigenschaftenObjekt)

'löschen der vorhandenen Benutzerparameter und der benutzerdefinierten Properties, die mit "DBSet" beginnen
Dim Suchkriterium As String
Dim Ausschlusskrit As String
If oSubDoc.DocumentType = kPartDocumentObject Then
Suchkriterium = "nicht Löschen"
' Suchkriterium = "DBSet"
Ausschlusskrit = "Flaeche"
Else If oSubDoc.DocumentType = kAssemblyDocumentObject Then
Suchkriterium = "nicht Löschen"
' Suchkriterium = "DBSet"
End If

'Benutzerparameter
DeleteUserParameters(oSubDoc, Suchkriterium, Ausschlusskrit) 'Programmaufruf zum Löschen der Benutzerparameter
' DeleteUserParameters(ThisApplication.ActiveDocument, Suchkriterium) 'Programmaufruf zum Löschen der Benutzerparameter
'MessageBox.Show("Alle benutzerdefinierten Parameter mit ""DBSet"" wurden gelöscht.", "Erfolg", MessageBoxButtons.OK, MessageBoxIcon.Information)

'benutzerdefinierte Properties
DeleteUserProperties(oSubDoc, Suchkriterium) 'Programmaufruf zum Löschen der benutzerdefinierten Properties
' DeleteUserProperties(ThisApplication.ActiveDocument, Suchkriterium) 'Programmaufruf zum Löschen der benutzerdefinierten Properties
'MessageBox.Show("Alle benutzerdefinierten Parameter mit ""DBSet"" wurden gelöscht.", "Erfolg", MessageBoxButtons.OK, MessageBoxIcon.Information)

'Baugruppen aktualisieren
InventorVb.DocumentUpdate()

'Schleife über alle Merkmale des jeweiligen Bauteils
For i = Startzeile To Endzeile
Dim Zelle_Bi As String = "B" & i ' Spalte B: Propertieset
Dim Zelle_Ci As String = "C" & i ' Spalte C: Eigenschaftsname
Dim Zelle_Di As String = "D" & i ' Spalte D: Eigenschaftswert
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

Try
Propertieset = GoExcel.CellValue(Eigenschaftentabelle, "Tunnelbau", Zelle_Bi)
' Propertieset = GeöffnetesObjekt
Eigenschaftenname = GoExcel.CellValue(Eigenschaftentabelle, "Tunnelbau", Zelle_Ci)
Wert = GoExcel.CellValue(Eigenschaftentabelle, "Tunnelbau", Zelle_Di)
Einheit = GoExcel.CellValue(Eigenschaftentabelle, "Tunnelbau", Zelle_Ii)
Typ = GoExcel.CellValue(Eigenschaftentabelle, "Tunnelbau", Zelle_Fi)
Beschreibung = GoExcel.CellValue(Eigenschaftentabelle, "Tunnelbau", Zelle_Hi)
Catch
If GeöffnetesObjekt.contains("") = True Then
MsgBox("Das Bautel " & GetDisplayName(oSubDoc) & " enthält in dem iProperty ""Projekt -> Beschzeichnung"" im Namen " & GeöffnetesObjekt & " vermutlich ein Leerzeichen." & vbCrLf & _
"Überpüfen Sie bitte den Inhalt in dem iProperty und entfernen Sie das Leerzeichen." & vbCrLf & vbCrLf & _
"Das Programm wird hier beendet. Nach der Korrektur muss das Programm erneut ausgeführt werden.")
MsgBox("Bauteil in Unterbaugruppe:" & vbCrLf & vbCrLf & "Dateiname: " & oSubDoc.FullFileName & vbCrLf & vbCrLf & _
"Anzeigename: " & GetDisplayName(oSubDoc) & vbCrLf & vbCrLf & _
"Geöffnetes Objekt: " & GeöffnetesObjekt & vbCrLf & _
"Geöffnetes Objekt 130: " & GeöffnetesObjekt_130 & vbCrLf & _
"Geöffnetes Objekt 140: " & GeöffnetesObjekt_140 & vbCrLf & _
"Eigenschaftentabelle: " & Eigenschaftentabelle & vbCrLf & vbCrLf & _
"Startzeile: " & Startzeile & vbCrLf & "Endzeile: " & Endzeile & vbCrLf & "Anzahle Zeilen: " & AnzahlEigenschaftenObjekt & vbCrLf & "Zeilennummer: " & i)
Exit Sub
End If

End Try

'-------------Bauteil---------------------
If oSubDoc.DocumentType = kPartDocumentObject Then
If Typ = "Eigenschaft" Then
'MsgBox("1. If-Then: Eigenschaft - Spalte Typ:" & vbCrLf & "Dokument: " & GetDisplayName(oSubDoc) & vbCrLf & "Zeilennummer i: " & i & vbCrLf & "Eigenschaftenname: " & Eigenschaftenname & vbCrLf & "Wert: " & Wert & vbCrLf & "Beschreibung: " & Beschreibung)
EigenschaftenEinheit = Einheit
Zähler_Eigenschaft = iPropertieCheck(GetDisplayName(oSubDoc), "Custom", Propertieset, Eigenschaftenname, "ND") 'Aufruf der Funktion "iPropertieCheck"  - In Bauteilen wird in den Properties zunächst "ND" eingetragen und später ersetzt
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 Typ:" & vbCrLf & "Dokument: " & GetDisplayName(oSubDoc) & vbCrLf & "Zeilennummer i: " & i & vbCrLf & "Eigenschaftenname :" & Eigenschaftenname & vbCrLf & "Wert :" & Wert & vbCrLf & "Einheit :" & EigenschaftenEinheit & vbCrLf & "Beschreibung: " & Beschreibung)
Zähler_Benutzerparameter = BenutzerParameterAnlegen(oSubDoc, i, Propertieset, Eigenschaftenname, Wert, EigenschaftenEinheit, Beschreibung, Eigenschaftentabelle, BlattnameTunnel, GetDisplayName(oSubDoc)) 'Aufruf der Funktion "BenutzerParameterAnlegen"
Erzeugter_Benutzerparameter = Erzeugter_Benutzerparameter + Zähler_Benutzerparameter
Nummer_Benutzerparameter = Nummer_Benutzerparameter + 1
End If

'------------Baugruppe------------------
Else If oSubDoc.DocumentType = kAssemblyDocumentObject Then
If Typ = "Eigenschaft" Then
'MsgBox("1. If-Then: Eigenschaft - Spalte Name:" & vbCrLf & "Zeilennummer i: " & i & vbCrLf & "Eigenschaftenname: " & Eigenschaftenname & vbCrLf & "Wert: " & Wert & vbCrLf & "Beschreibung: " & Beschreibung & vbCrLf & "Baugruppe: " & GetDisplayName(oSubDoc))
EigenschaftenEinheit = Einheit
Zähler_Eigenschaft = iPropertieCheck(GetDisplayName(oSubDoc),"Custom", Propertieset, Eigenschaftenname, "") 'Aufruf der Funktion "iPropertieCheck" - In Baugruppen wird in den Properties "" eingetragen
Erzeugte_Eigenschaft = Erzeugte_Eigenschaft + Zähler_Eigenschaft
Nummer_Eigenschaft = Nummer_Eigenschaft + 1
End If

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

End If
Next

'Im Tabellenblatt des Bauteils nach Anzahl der Zeilen suchen
Startzeile_Bauteilblatt = ErmittlungStarzeile(Anzahl_Zeilen, Eigenschaftentabelle, Tabellenblatt_Name, GeöffnetesObjekt)
Endzeile_Bauteilblatt = ErmittlungEndzeile(Anzahl_Zeilen, Eigenschaftentabelle,  Tabellenblatt_Name, GeöffnetesObjekt)

If Startzeile_Bauteilblatt = -1 Or Endzeile_Bauteilblatt = -1 Then
If oSubDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
MessageBox.Show("Das Tabellenblatt """ & Tabellenblatt_Name & """ ist nicht vorhanden. Bitte prüfen Sie, ob in der Datei " & oSubDoc.FullFileName & " die Werte in den Eigenschaften ""z_Matchkey_130"" und ""z_Matchkey_130"" korrekt angegeben sind." & vbLf & vbLf & _
"Das Programm wird trotzdem fortgeführt. Korrigieren Sie gegebenenfalls in dem Bauteil die Werte in den Eigenschaften ""z_Matchkey_130"" und ""z_Matchkey_130""." & vbLf & vbLf & _
"In der Eigenschaft ""z_Matchkey_130"" ist der Wert " & GeöffnetesObjekt_130 & " enthalten. Dieser Wert müsste z.B. ""KALO"" sein." & vbLf & _
"In der Eigenschaft ""z_Matchkey_140"" ist der Wert " & GeöffnetesObjekt_140 & " enthalten. Dieser Wert müsste z.B. ""ORTB"" sein.", _
"Blattname nicht vorhanden", MessageBoxButtons.OK, MessageBoxIcon.Information)
Exit Try
Else
'passiert nichts und macht weiter
End If
End If

' AnzahlEigenschaftenObjekt = Endzeile_Bauteilblatt - Startzeile_Bauteilblatt
' MsgBox("Bauteil in Unterbaugruppe:" & vbCrLf & vbCrLf & "Geöffnetes Objekt: " & GeöffnetesObjekt & vbCrLf & "Eigenschaftentabelle: " & Eigenschaftentabelle & vbCrLf & vbCrLf & "Startzeile Bauteilblatt: " & Startzeile_Bauteilblatt & vbCrLf & "Endzeile Bauteilblatt: " & Endzeile_Bauteilblatt & vbCrLf & "Anzahle Zeilen: " & AnzahlEigenschaftenObjekt)

' MessageBox.Show("Kontrolle Funktionsaufruf ""MultiauswahllisteAuswahl"": " & vbCrLf & "Objekt: " & GeöffnetesObjekt)

'--------------------
'In Bauteilen die Werte der Parameter in Properties übernehmen
If oSubDoc.DocumentType = kPartDocumentObject Then
Dim param As Parameter
For Each param In oSubDoc.ComponentDefinition.Parameters
param.ExposedAsProperty = False ' Benutzerparameter als Exportparameter ausschalten
ParamName = param.Name ' Name des Benutzerparameters
ParamInhalt = param.Value ' Wert/Gleichung des Benutzerparametrs
If param.name.contains("DBSet") Then
param.ExposedAsProperty = True ' Benutzerparameter als Exportparameter einschalten

'MsgBox("Dokument: " & GetDisplayName(oSubDoc) & vbCrLf & vbCrLf & "Parametername: " & ParamName & vbCrLf & vbCrLf & "Parameterwert: " & ParamInhalt)
MultiauswahllisteAuswahl(oSubDoc, Startzeile_Bauteilblatt, Endzeile_Bauteilblatt, Eigenschaftentabelle, Tabellenblatt_Name, GeöffnetesObjekt, ParamName, ParamInhalt)
End If
Next
End If

End Try
    End If

iCount = iCount + 1
Next
End If

' End If

'Baugruppen aktualisieren
InventorVb.DocumentUpdate()

Endzeit = DateTime.Now.ToShortTimeString
Dauer = DateDiff("n",Startzeit, Endzeit)

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." & Chr(13) & Chr(13) & chr(13) _
& "Startzeit Programm: " & Startzeit & Chr(13) & "Endzeit Programm: " & Endzeit & Chr(13) & "Dauer der Laufzeit des Programms: " & Dauer & "Minuten", "iPropertie", MessageBoxButtons.OK, MessageBoxIcon.Information)

End Sub

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

'********************************************************************
'Funktion zur Ermittlung der ersten Zeile eines Eigenschaftensatzes
'********************************************************************

Private Function ErmittlungStarzeile(Zeilenanzahl As Integer, Tabellennamen As String, Blattnamen As String, Objekt As String)
'Ermittlung der Startzeile der Eigenschaften für das ausgewählte Objekt
Try
For i = 1 To Zeilenanzahl
Dim Zelle_Ai As String = "A" & i ' Spalte A: Objektname
Objektname = GoExcel.CellValue(Tabellennamen, Blattnamen, Zelle_Ai)

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

Catch
' MessageBox.Show("Das Tabellenblatt """ & Blattnamen & """ ist nicht vorhanden. Bitte prüfen Sie, ob die Werte in den Eigenschaften ""z_Matchkey_130"" und ""z_Matchkey_130"" korrekt angegeben sind." & vbLf & vbLf & _
' "Das Programm wird beendet. Korrigieren Sie die Werte in den Eigenschaften ""z_Matchkey_130"" und ""z_Matchkey_130"".", _
' "Blattname nicht vorhanden", MessageBoxButtons.OK, MessageBoxIcon.Information)

Startzeile = -1
End Try

Return Startzeile

End Function

'********************************************************************
'Funktion zur Ermittlung der letzten Zeile eines Eigenschaftensatzes
'********************************************************************

Private Function ErmittlungEndzeile(Zeilenanzahl As Integer, Tabellennamen As String, Blattnamen As String, Objekt As String)
'Ermittlung der Endzeile der Eigenschaften für das ausgewählte Objekt
Try
For i = 1 To Zeilenanzahl
Dim Zelle_Ai As String = "A" & i ' Spalte A: Objektname
Objektname = GoExcel.CellValue(Tabellennamen, Blattnamen, Zelle_Ai)

If Objektname = Objekt Then
Endzeile = i
'MsgBox("Objekt: " & Objektname & vbCrLf & "Endzeile: " & Endzeile)
End If
Next
Catch
Endzeile = -1
End Try

Return Endzeile

End Function

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

Private Function iPropertieCheck(Bauteilname As String, Reiter As String, PSet As String, Eigenschaft As String, Eigenschaftswert As String) As Integer
Dim Bezeichnung As String = PSet & ":" & Eigenschaft
Try
iProp = iProperties.Value(Bauteilname, Reiter, Bezeichnung)

' 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, Bezeichnung) = 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 = ""
' End If

iProperties.Value(Bauteilname, Reiter, Bezeichnung) = 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, PSet As String, Eigenschaft As String, Eigenschaftswert As String, Einheitentyp As String, Eigenschaftsbeschreibung As String, Tabellenname As String, Blattname As String, Optional Bauteilname As String = "") As Integer
'vorhandene Benutzerparameter werden einmal gelöscht und anschließend wieder neu angelegt
'noch nicht vorhandene Benutzerparameter werden angelegt.

'Erstellen der Benutzerparameter
Dim Benutzerparameter As UserParameters
Benutzerparameter = oDoc.ComponentDefinition.Parameters.UserParameters
Benutzerparametername = "z_" & PSet & ":" & Eigenschaft
Suchbegriff_1 = "Laenge" '[m]
Suchbegriff_2 = "laenge" '[m]
Suchbegriff_3 = "Dicke" '[m]
Suchbegriff_4 = "Durchmesser_" '[mm]
Suchbegriff_5 = "durchmesser_" '[mm]
Suchbegriff_6 = ":tb" '[cm]
Suchbegriff_7 = ":ue" '[cm]
Suchbegriff_8 = ":ta" '[cm]
Suchbegriff_9 = ":td" '[cm]
Suchbegriff_10 = ":ti" '[cm]
Suchbegriff_11 = "Ankeranzahl" 'ganze Zahl [oE]
Suchbegriff_12 = "Anzahl_Anker" 'ganze Zahl [oE]
Suchbegriff_13 = "Anzahl_Bewehrungsmuffen" 'ganze Zahl [oE]
Suchbegriff_14 = "Anzahl_Bohrungen" 'ganze Zahl [oE]
Suchbegriff_15 = "Anzahl_Rohre" 'ganze Zahl [oE]
Suchbegriff_16 = "Rohranzahl" 'ganze Zahl [oE]
Suchbegriff_17 = "Spiessanzahl" 'ganze Zahl [oE]
Suchbegriff_18 = "Anzahl_Ankerschienen" 'ganze Zahl [oE]
Suchbegriff_19 = "Anzahl_Steckduebel" 'ganze Zahl [oE]
Suchbegriff_20 = "Anzahl_Steine" 'ganze Zahl [oE]
Suchbegriff_21 = "Anzahl_Verpressstutzen" 'ganze Zahl [oE]
Suchbegriff_22 = "Volumen" '[m3]
Suchbegriff_23 = "volumen" '[m3]
Suchbegriff_24 = "Einzelmasse_Stahl_Matte" '[kg]
Suchbegriff_25 = "Einzelmasse_Stahl_Ausbaubogen" '[kg]
Suchbegriff_26 = "Aussenflaeche" '[m2]
Suchbegriff_27 = "Flaeche" '[m2]
Suchbegriff_28 = "querschnitt" '[m2]

Einheit_1 = "Fläche.m2" '[m2]
Einheit_2 = "ganze Zahl" '[oE]
Einheit_3 = "Länge.cm" '[cm]
Einheit_4 = "Länge.m" '[m]
Einheit_5 = "Länge.mm" '[mm]
Einheit_6 = "reelle Zahl" '[oE]
Einheit_7 = "Text" '[Text]
Einheit_8 = "Volumen.m3" '[m3]
Einheit_9 = "Wahr/Falsch" '[boolean]

'Kontrolle
' If Einheitentyp = Einheit_1 Then
' MsgBox("Im Bauteil """ & Bauteilname & """ besitzt der Benutzerparameter """ & Benutzerparametername & """ den Einheitentyp: " & Einheitentyp & vbCrLf & "Die Vergleichswerte für die Einheit sind: " & Einheit_1)
' End If

'Benutzerparameter ist bereits vorhanden
Try
BenPara = Benutzerparameter.Item(Benutzerparametername)
'MsgBox("Benutzerparametername: " & Benutzerparametername & " ist vorhanden.")

If Benutzerparametername.Contains(Suchbegriff_22) = True _
Or Benutzerparametername.Contains(Suchbegriff_23) = True Then 'Volumen
'MsgBox("Benutzerparametername enthält " & Suchbegriff_22 & ", " & Suchbegriff_23)
Benutzerparameter.Item(Benutzerparametername).Delete
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauetil
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, Round(iProperties.Volume, 2), "m^3")
End If

'----

Else If Benutzerparametername.Contains(Suchbegriff_24) = True _
Or Benutzerparametername.Contains(Suchbegriff_25) = True Then 'Einzelmasse
'MsgBox("Benutzerparametername enthält " & Suchbegriff_24 & ", " & Suchbegriff_25)
Benutzerparameter.Item(Benutzerparametername).Delete
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauetil
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, Round(iProperties.Mass,2), "kg")
End If

'----

Else If Benutzerparametername.Contains(Suchbegriff_6) = True Then 'tb
'MsgBox("Benutzerparametername enthält " & Suchbegriff_6)
Benutzerparameter.Item(Benutzerparametername).Delete
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauetil
Try
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, "IS_T_b_M1", UnitsTypeEnum.kCentimeterLengthUnits) 'In Bauteil Parameter eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann der Wert ""IS_T_b_M1"" nicht zugeordnet werden, da dieser nicht aus dem Skelett abgeleitet wurde." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt. Leiten Sie den fehlenden Parameter aus dem Skelett ab, bevor Sie das Programm erneut starten, um den Benutzerparameter anzulegen.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
End If

'----

Else If Benutzerparametername.Contains(Suchbegriff_7) = True Then 'ue
'MsgBox("Benutzerparametername enthält " & Suchbegriff_7)
Benutzerparameter.Item(Benutzerparametername).Delete
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauetil
Try
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, "AS_U_IST", UnitsTypeEnum.kCentimeterLengthUnits) 'In Bauteil Parameter eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann der Wert ""AS_U_IST"" nicht zugeordnet werden, da dieser nicht aus dem Skelett abgeleitet wurde." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt. Leiten Sie den fehlenden Parameter aus dem Skelett ab, bevor Sie das Programm erneut starten, um den Benutzerparameter anzulegen.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
End If

'---

Else If Benutzerparametername.Contains(Suchbegriff_8) = True Then 'ta
'MsgBox("Benutzerparametername enthält " & Suchbegriff_8)
Benutzerparameter.Item(Benutzerparametername).Delete
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauetil
Try
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, "AS_Ta_IST", UnitsTypeEnum.kCentimeterLengthUnits) 'In Bauteil Parameter eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann der Wert ""AS_Ta_IST"" nicht zugeordnet werden, da dieser nicht aus dem Skelett abgeleitet wurde." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt. Leiten Sie den fehlenden Parameter aus dem Skelett ab, bevor Sie das Programm erneut starten, um den Benutzerparameter anzulegen.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
End If

'----

Else If Benutzerparametername.Contains(Suchbegriff_9) = True Then 'td
'MsgBox("Benutzerparametername enthält " & Suchbegriff_9)
Benutzerparameter.Item(Benutzerparametername).Delete
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauetil
Try
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, "AS_Td_IST", UnitsTypeEnum.kCentimeterLengthUnits) 'In Bauteil Parameter eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann der Wert ""AS_Td_IST"" nicht zugeordnet werden, da dieser nicht aus dem Skelett abgeleitet wurde." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt. Leiten Sie den fehlenden Parameter aus dem Skelett ab, bevor Sie das Programm erneut starten, um den Benutzerparameter anzulegen.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
End If

'----

Else If Benutzerparametername.Contains(Suchbegriff_10) = True Then 'ti
'MsgBox("Benutzerparametername enthält " & Suchbegriff_10)
Benutzerparameter.Item(Benutzerparametername).Delete
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauetil
Try
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, "AS_Ti_IST", UnitsTypeEnum.kCentimeterLengthUnits) 'In Bauteil Parameter eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann der Wert ""AS_Ti_IST"" nicht zugeordnet werden, da dieser nicht aus dem Skelett abgeleitet wurde." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt. Leiten Sie den fehlenden Parameter aus dem Skelett ab, bevor Sie das Programm erneut starten, um den Benutzerparameter anzulegen.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
End If

End If

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




'Benutzerparameter ist noch nicht vorhanden und wird neu angelegt
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)

If Benutzerparametername.Contains(Suchbegriff_1) = True _ 'Länge, Dicke - [m]
Or Benutzerparametername.Contains(Suchbegriff_2) = True _
Or Benutzerparametername.Contains(Suchbegriff_3) = True Then
'MsgBox("Benutzerparametername enthält " & Suchbegriff_1 & ", " & Suchbegriff_2 & Suchbegriff_3 & ", " & Suchbegriff_4 & Suchbegriff_5)
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauetil
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, Eigenschaftswert, UnitsTypeEnum.kMeterLengthUnits) '[m]
' BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, "-99999", UnitsTypeEnum.kMeterLengthUnits)
End If

'----

Else If Benutzerparametername.Contains(Suchbegriff_4) = True _ 'Durchmesser - [mm]
Or Benutzerparametername.Contains(Suchbegriff_5) = True Then
'MsgBox("Benutzerparametername enthält " & Suchbegriff_1 & ", " & Suchbegriff_2 & Suchbegriff_3 & ", " & Suchbegriff_4 & Suchbegriff_5)
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauetil
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, Eigenschaftswert, "mm") '[mm]
' BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, "-99999", "mm")
End If

'----

Else If Benutzerparametername.Contains(Suchbegriff_6) = True Then 'tb
' Else If Benutzerparametername.Contains(Suchbegriff_6) = True And oDoc.DocumentType = kPartDocumentObject Then 'tb und Bauteil
'MsgBox("Benutzerparametername enthält " & Suchbegriff_6)
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauetil
Try
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, "IS_T_b_M1", UnitsTypeEnum.kCentimeterLengthUnits) 'In Bauteil Parameter eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann der Wert ""IS_T_b_M1"" nicht zugeordnet werden, da dieser nicht aus dem Skelett abgeleitet wurde." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt. Leiten Sie den fehlenden Parameter aus dem Skelett ab, bevor Sie das Programm erneut starten, um den Benutzerparameter anzulegen.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
End If

'----

Else If Benutzerparametername.Contains(Suchbegriff_7) = True Then 'ue
' Else If Benutzerparametername.Contains(Suchbegriff_7) = True And oDoc.DocumentType = kPartDocumentObject Then 'ue und Bauteil
'MsgBox("Benutzerparametername enthält " & Suchbegriff_7)
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauteil
Try
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, "AS_U_IST", UnitsTypeEnum.kCentimeterLengthUnits) 'In Bauteil Parameter eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann der Wert ""AS_U_IST"" nicht zugeordnet werden, da dieser nicht aus dem Skelett abgeleitet wurde." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt. Leiten Sie den fehlenden Parameter aus dem Skelett ab, bevor Sie das Programm erneut starten, um den Benutzerparameter anzulegen.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
End If

'----

Else If Benutzerparametername.Contains(Suchbegriff_8) = True Then 'ta
' Else If Benutzerparametername.Contains(Suchbegriff_8) = True And oDoc.DocumentType = kPartDocumentObject Then 'ta und Bauteil
'MsgBox("Benutzerparametername enthält " & Suchbegriff_8)
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauteil
Try
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, "AS_Ta_IST", UnitsTypeEnum.kCentimeterLengthUnits) 'In Bauteil Parameter eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann der Wert ""AS_Ta_IST"" nicht zugeordnet werden, da dieser nicht aus dem Skelett abgeleitet wurde." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt. Leiten Sie den fehlenden Parameter aus dem Skelett ab, bevor Sie das Programm erneut starten, um den Benutzerparameter anzulegen.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
End If

'----

Else If Benutzerparametername.Contains(Suchbegriff_9) = True And oDoc.DocumentType = kPartDocumentObject Then 'td und Bauteil
'MsgBox("Benutzerparametername enthält " & Suchbegriff_9)
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauteil
Try
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, "AS_Td_IST", UnitsTypeEnum.kCentimeterLengthUnits) 'In Bauteil Parameter eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann der Wert ""AS_Td_IST"" nicht zugeordnet werden, da dieser nicht aus dem Skelett abgeleitet wurde." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt. Leiten Sie den fehlenden Parameter aus dem Skelett ab, bevor Sie das Programm erneut starten, um den Benutzerparameter anzulegen.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
End If

'----

Else If Benutzerparametername.Contains(Suchbegriff_10) = True And oDoc.DocumentType = kPartDocumentObject Then 'ti und Bauteil
'MsgBox("Benutzerparametername enthält " & Suchbegriff_10)
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauteil
Try
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, "AS_Ti_IST", UnitsTypeEnum.kCentimeterLengthUnits) 'In Bauteil Parameter eintragen

Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann der Wert ""AS_Ti_IST"" nicht zugeordnet werden, da dieser nicht aus dem Skelett abgeleitet wurde." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt. Leiten Sie den fehlenden Parameter aus dem Skelett ab, bevor Sie das Programm erneut starten, um den Benutzerparameter anzulegen.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
End If

'----

Else If Benutzerparametername.Contains(Suchbegriff_11) = True _ 'Anzahl (ganze Zahl)
Or Benutzerparametername.Contains(Suchbegriff_12) = True _
Or Benutzerparametername.Contains(Suchbegriff_13) = True _
Or Benutzerparametername.Contains(Suchbegriff_14) = True _
Or Benutzerparametername.Contains(Suchbegriff_15) = True _
Or Benutzerparametername.Contains(Suchbegriff_16) = True _
Or Benutzerparametername.Contains(Suchbegriff_17) = True _
Or Benutzerparametername.Contains(Suchbegriff_18) = True _
Or Benutzerparametername.Contains(Suchbegriff_19) = True _
Or Benutzerparametername.Contains(Suchbegriff_20) = True _
Or Benutzerparametername.Contains(Suchbegriff_21) = True Then
'MsgBox("Benutzerparametername enthält " & Suchbegriff_11 & ", " & Suchbegriff_12 & ", " & Suchbegriff_12 & ", " & Suchbegriff_12 & ", " & Suchbegriff_12 & ", " & Suchbegriff_12 & ", " & _
'Suchbegriff_12 & ", " & Suchbegriff_12 & ", " & Suchbegriff_12 & ", " & Suchbegriff_12 & ", " & Suchbegriff_12 & ", " & Suchbegriff_12)
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauteil
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, Eigenschaftswert, UnitsTypeEnum.kUnitlessUnits)
' BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, "-99999", UnitsTypeEnum.kUnitlessUnits)
End If

'----

Else If Benutzerparametername.Contains(Suchbegriff_22) = True _ 'Volumen
Or Benutzerparametername.Contains(Suchbegriff_23) = True Then
'MsgBox("Benutzerparametername enthält " & Suchbegriff_22 & ", " & Suchbegriff_23)
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauteil
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, Round(iProperties.Volume,2), "m^3")
' BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, Round(iProperties.Volume,2), "m^3", UnitsTypeEnum.kLiterVolumeUnits)
End If

'----

Else If Benutzerparametername.Contains(Suchbegriff_24) = True _ 'Einzelmasse
Or Benutzerparametername.Contains(Suchbegriff_25) = True Then
' MsgBox("Benutzerparametername enthält " & Suchbegriff_24 & ", " & Suchbegriff_25)
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauteil
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, Round(iProperties.Mass,2), "kg")
End If

'----

Else If Benutzerparametername.Contains(Suchbegriff_26) = True _ 'Fläche [m2]
Or Benutzerparametername.Contains(Suchbegriff_27) = True  _
Or Benutzerparametername.Contains(Suchbegriff_28) = True  Then
'MsgBox("Benutzerparametername enthält " & Suchbegriff_26 & ", " & Suchbegriff_27 & ", " & Suchbegriff_28)
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauteil
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, Eigenschaftswert, "m^2")
' BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, "-99999", "m^2")
End If

'----

Else If Einheitentyp = Einheit_1 Then 'Fläche.m2
'MsgBox("Der Benutzerparameter """ & Benutzerparametername & """ besitzt den Einheitentyp: " & Einheitentyp & vbCrLf & "Die Vergleichswerte für die Einheit sind: " & Einheit_1)
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ mit der Einheit """ & Einheitentyp & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauteil
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, Eigenschaftswert, "m^2")
End If

'----

Else If Einheitentyp = Einheit_3 Then 'Länge.cm
'MsgBox("Der Einheitentyp ist: " & Einheitentyp & vbCrLf & "Die Vergleichswerte für die Einheit sind: " & Einheit_4)
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ mit der Einheit """ & Einheitentyp & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauteil
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, Eigenschaftswert, "cm")
End If

'----

Else If Einheitentyp = Einheit_4 Then 'Länge.m
'MsgBox("Der Einheitentyp ist: " & Einheitentyp & vbCrLf & "Die Vergleichswerte für die Einheit sind: " & Einheit_4)
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ mit der Einheit """ & Einheitentyp & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauteil
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, Eigenschaftswert, "m")
End If

'----

Else If Einheitentyp = Einheit_5 Then 'Länge.mm
'MsgBox("Der Einheitentyp ist: " & Einheitentyp & vbCrLf & "Die Vergleichswerte für die Einheit sind: " & Einheit_5)
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ mit der Einheit """ & Einheitentyp & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauteil
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, Eigenschaftswert, "mm")
End If

'----

Else If Einheitentyp = Einheit_2 Or Einheitentyp = Einheit_6 Then 'ganze Zahl, reelle Zahl
'MsgBox("Der Einheitentyp ist: " & Einheitentyp & vbCrLf & "Die Vergleichswerte für die Einheit sind: " & Einheit_2 & " und " & Einheit_6)
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ mit der Einheit """ & Einheitentyp & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauteil
BenPara = Benutzerparameter.AddByExpression(Benutzerparametername, Eigenschaftswert, UnitsTypeEnum.kUnitlessUnits)
End If

'----

Else
'MsgBox("Benutzerparametername enthält keinen der Suchbegriffe")
If oDoc.DocumentType = kAssemblyDocumentObject Then 'Baugruppe
Try
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits) 'In Baugruppe keinen Wert eintragen
Catch
MessageBox.Show("Dem Benutzerparameter """ & Benutzerparametername & """ kann kein leerer Wert zugewiesen werden." & vbLf & vbLf & _
"Das Programm wird fortgeführt, der Benutzerparameter """ & Benutzerparametername & """ aber nicht angelegt.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return Nothing
End Try
Else If oDoc.DocumentType = kPartDocumentObject 'Bauteil
BenPara = Benutzerparameter.AddByValue(Benutzerparametername, Eigenschaftswert, UnitsTypeEnum.kTextUnits)
' BenPara = Benutzerparameter.AddByValue(Benutzerparametername, "", UnitsTypeEnum.kTextUnits)
End If

'***

End If
' MsgBox("Der Benutzerparametername: "  & Benutzerparametername & " wurde angelegt.")

MultiauswahllisteAnlegen(oDoc, Zeile, Eigenschaft, Eigenschaftswert, Eigenschaftsbeschreibung, Benutzerparametername, Tabellenname, Blattname, 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, Blattname As String, Bauteilname As String) As Integer
'Erstellen der Mulitiauswahlliste

'If GetDisplayName(oDoc) = "23075801-Baugruppe_Kreise.iam" Then
' MsgBox("Kontrolle in Funktion ""MultiauswahllisteAnlegen""" & Chr(13) & Chr(13) & "Dokument: " & GetDisplayName(oDoc) & Chr(13) & _
' "Erstellung der Multiauswahlliste:" & vbCrLf & "Zeilennummer i: " & Zeile & vbCrLf & "Eigenschaftenname: " & Eigenschaft & vbCrLf & "Eigenschaftswert: " & Eigenschaftswert & vbCrLf & _
' "Eigenschaftsbeschreibung: " & Eigenschaftsbeschreibung & vbCrLf & "Eigenschaft/Benutzerparametername: " & Benutzerparametername & vbCrLf & "Bauteilname: " & Bauteilname)
'End If

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

Dim myParam As Inventor.Parameter = Parameter.Param(Bauteilname, Benutzerparametername)
Dim Liste As New ArrayList

If Bauteilname = "" Then
Liste = MultiValue.List(Benutzerparametername)
myParam.ExpressionList.AllowCustomValues = True
Else
Liste = MultiValue.List(Bauteilname, Benutzerparametername)
myParam.ExpressionList.AllowCustomValues = True
End If

If Liste.Contains(Eigenschaftsbeschreibung) Then
' nichts tun
Else
Liste.Add(Eigenschaftsbeschreibung)
If Bauteilname = "" Then
MultiValue.List(Benutzerparametername) = Liste
myParam.ExpressionList.AllowCustomValues = True
Else
MultiValue.List(Bauteilname, Benutzerparametername) = Liste
myParam.ExpressionList.AllowCustomValues = True
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 Wert aus Multiauswahlliste auswählen
'****************************************

Private Function MultiauswahllisteAuswahl(oDoc As Document, Start As Integer, Ende As Integer, TabName As String, BlattName As String, BauteilName As String, BenParamName As String, BenParamWert As String) As Integer
'Auswahl eines Wertes in der Mulitiauswahlliste

'Ermittlung der Werte für die Eigenschaften für das ausgewählte Objekt
For i = Start To Ende
Dim Zelle_Bi As String = "B" & i ' Spalte B: Propertieset
Dim Zelle_Ci As String = "C" & i ' Spalte C: Eigenschaftsname
Dim Zelle_Di As String = "D" & i ' Spalte D: Eigenschaftswert
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

Propertieset = GoExcel.CellValue(TabName, BlattName, Zelle_Bi)
Eigenschaftenname = GoExcel.CellValue(TabName, BlattName, Zelle_Ci)
ParameterWert = GoExcel.CellValue(TabName, BlattName, Zelle_Di)
Einheit = GoExcel.CellValue(TabName, BlattName, Zelle_Ii)
Typ = GoExcel.CellValue(TabName, BlattName, Zelle_Fi)
Beschreibung = CStr(GoExcel.CellValue(TabName, BlattName, Zelle_Hi))

BenutzerparameterName = "z_" & Propertieset & ":" & Eigenschaftenname ' zusammengesetzer Name des Benutzerparameters aus Elementen der Exceltabelle
iPropertyName = Propertieset & ":" & Eigenschaftenname ' zusammengesetzer Name des iProperty aus Elementen der Exceltabelle
If BenParamName = BenutzerparameterName And Typ = "Eigenschaft" Then
PropEinheit = Einheit
End If

If BenParamName = BenutzerparameterName And Typ = "Wert [Werteliste]" Then

'MessageBox.Show("Kontrolle Funktion ""MultiauswahllisteAuswahl"": " & vbCrLf & vbCrLf & "Benutzerparametername: " & BenParamName & vbCrLf & "Objekt: " & GetDisplayName(oDoc))

' Setze den Benutzerparameter basierend auf der Auswahl
If BenParamName IsNot Nothing Then
  
If MultiValue.List(GetDisplayName(oDoc), BenParamName).Contains(Beschreibung) Then
'Wert ist gültig
'MessageBox.Show("Der Wert """ & Beschreibung & """ ist für den Benutzerparameter " & BenParamName & " gültig!")

'Versuche in den Benutzerparameter den Wert aus der Exceltabelle einzutragen
Try
Parameter(GetDisplayName(oDoc), BenParamName) = Beschreibung 'Ordne den Wert "Beschreibung" dem Parameter "BenParamName" zu

'Überprüfe, ob die Beschreibung aus der Exceltabelle dem Wert im Benutzerparameter entspricht
If Beschreibung = BenParamWert Then
' MessageBox.Show("zusammengesetzer Name des iProperties aus Elementen der Exceltabelle: " & BenutzerparameterName & vbCrLf & "Abkürzung des Eigenschaftswertes aus Exceltabelle: " & ParameterWert & vbCrLf & vbCrLf & _
' "Name des Benutzerparameters: " & PName & vbCrLf & vbCrLf & "zusammengesetzer Name des iProperty aus Elementen der Exceltabelle: " & iPropertyName & vbCrLf & _
' "Beschreibung des Eigenschaftswertes aus Exceltabelle: " & Beschreibung & vbCrLf & "Wert/Gleichung des Benutzerparametrs: " & PWert & vbCrLf & vbCrLf & _
' "Wert der in iPropertie " & iPropertyName & " geschrieben wird: " & ParameterWert, "Zusammenfassung Benutzerparameter und iProperties", MessageBoxButtons.OK, MessageBoxIcon.Information)

iProperties.Value(GetDisplayName(oDoc), "Custom", iPropertyName) = ParameterWert ' Übernahme der zugehörigen Abkürzungen aus der Exceltabelle in das iProperty
Exit For

'Wenn die Beschreibung aus der Exceltabelle nicht dem Wert im Benutzerparameter entspricht, prüfe um was für einen Parameter es sich handelt udn rechne die Einheit um
Else If Beschreibung <> BenParamWert Then
If BenutzerparameterName.Contains("Volumen") = True Then
PWertV = BenParamWert / 1000000
iProperties.Value(GetDisplayName(oDoc), "Custom", iPropertyName) = PWertV ' Übernahme des Volumens aus den Benutzerparametern und Umrechnung in m3
Exit For
Else If BenutzerparameterName.Contains("Aussenflaeche") = True Or BenutzerparameterName.Contains("Flaeche") = True Or BenutzerparameterName.Contains("querschnitt") = True Then
PWertF = Round(BenParamWert / 10000,3)
iProperties.Value(GetDisplayName(oDoc), "Custom", iPropertyName) = PWertF ' Übernahme der Fläche aus den Benutzerparametern und Umrechnung in m2
Exit For
Else If BenutzerparameterName.Contains("Laenge") = True Or BenutzerparameterName.Contains("laenge") = True Then
PWertL = Round(BenParamWert / 100,2)
iProperties.Value(GetDisplayName(oDoc), "Custom", iPropertyName) = PWertL ' Übernahme der Länge aus den Benutzerparametern und Umrechnung in m
Exit For
Else If BenutzerparameterName.Contains("Dicke") = True Then
PWertL = Round(BenParamWert / 100,2)
iProperties.Value(GetDisplayName(oDoc), "Custom", iPropertyName) = PWertL ' Übernahme der Dicke aus den Benutzerparametern und Umrechnung in m
Exit For
Else If BenutzerparameterName.Contains("Durchmesser") = True Or BenutzerparameterName.Contains("durchmesser") = True Then
PWertL = Round(BenParamWert * 10,1)
iProperties.Value(GetDisplayName(oDoc), "Custom", iPropertyName) = PWertL ' Übernahme des Durchmessers aus den Benutzerparametern und Umrechnung in mm
Exit For
Else
iProperties.Value(GetDisplayName(oDoc), "Custom", iPropertyName) = BenParamWert ' Übernahme der frei eingegebenen Werte aus den Benutzerparametern
Exit For
End If
End If

'Der Wert konnte nicht in den Benutzerparameter eingetragen werden
Catch
' MessageBox.Show("Anzeigename / Objekt: " & GetDisplayName(oDoc) & vbCrLf & _
' "Benutzerparametername aus Bauteil: " & BenParamName & vbCrLf & _
' BenParamWert & " : Benutzerparameter aus Bauteil" & vbCrLf & _
' param & " : Gleichung Benutzerparameter aus Bauteil" & vbCrLf & _
' Beschreibung & " : Beschreibung aus Exceltabelle")

MessageBox.Show("Auswahl in Benutzerparameter:" & vbLf & vbLf & "Im Bauteil " & GetDisplayName(oDoc) & " kann dem Benutzerparameter """ & BenParamName & """ der Wert """ & Beschreibung & _
""" nicht zugeordnet werden, da dieser nicht aus dem Skelett abgeleitet wurde oder der Name nicht der Datenstrukktur (Exceltabelle) entspricht." & vbLf & vbLf & _
"Das Programm wird fortgeführt, dem Benutzerparameter """ & BenParamName & """ aber nicht der Wert """ & Beschreibung & """ neu zugewiesen. Die Bisherige Auswahl bleibt erhalten." & vbLf & _
"Überprüfen Sie dennoch den Parameter und die Auswahl bzw. die Schreibweisen bevor Sie das Programm erneut starten, um den Benutzerparameter anzulegen.", _
"Benutzerparameter", MessageBoxButtons.OK, MessageBoxIcon.Information)


End Try

Else
' Wert ist ungültig
'MessageBox.Show("Der Wert """ & Beschreibung & """ ist für den Benutzerparameter " & BenParamName & " ungültig!")
End If

Else
    MessageBox.Show("Keine Auswahl getroffen.")
End If
End If
Next

End Function

'****************************************
'Funktion Abkürzungen in iProperties schreiben
'****************************************

Private Function CodeProp(oDoc As Document, Start As Integer, Ende As Integer, TabName As String, BlattName As String, BauteilName As String, BenParamName As String, BenParamWert As String) As Integer
'Auswahl eines Wertes in der Mulitiauswahlliste

'define custom property collection
oBenutzerPropertySet = oDoc.PropertySets.Item("Inventor User Defined Properties")
'look at each property in the collection
For Each oCustProp In oBenutzerPropertySet
'delete the custom iProperty
' if oCustProp.name = 
Next

End Function

'****************************************
'Programm zum Löschen aller Benutzerparameter mit einem definierten Textinhalt (hier "DBSet") aber nicht mit dem Ausschlusstext (hier "Flaeche") im Namen, um überflüssige Benutzerparameter zu entfernen
'****************************************
Sub DeleteUserParameters(ByVal doc As Document, Suchtext As String, Ausschlusstext As String)
   
'MsgBox("Suchkriterium: " & Suchtext)

On Error Resume Next
    Dim params As UserParameters
    params = doc.ComponentDefinition.Parameters.UserParameters
   
    Dim i As Integer
    For i = params.Count To 1 Step -1
        BenName = params.Item(i).Name
'MsgBox("Parameternummer: " & i & vbLf & "Parametername: " & BenName)
If BenName.Contains(Suchtext) And BenName.Contains(Ausschlusstext) Then
'MessageBox.Show("Der Benutzerparameter im Document " & GetDisplayName(doc) & " enthält den Suchtext " & Suchtext & " und den Ausschlusstext  " & Ausschlusstext & " und wird nicht gelöscht.", "Kontrolle", MessageBoxButtons.OK, MessageBoxIcon.Information)
ElseIf BenName.Contains(Suchtext) And Not BenName.Contains(Ausschlusstext) Then
'MessageBox.Show("Der Benutzerparameter im Document " & GetDisplayName(doc) & " enthält den Suchtext " & Suchtext & " und nicht den Ausschlusstext  " & Ausschlusstext & " und wird gelöscht.", "Kontrolle", MessageBoxButtons.OK, MessageBoxIcon.Information)
params.Item(i).Delete
Else
'MessageBox.Show("Der Benutzerparameter im Document " & GetDisplayName(doc) & " enthält nicht den Suchtext " & Suchtext & " und beibehalten, "Kontrolle", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
    Next i
    On Error GoTo 0
End Sub

'**********************************************************************************************
' Programm zum Löschen aller vorhanden benutzerdefinierten Prpoerties mit einem definierten Textinhalt (hier "DBSet") im Namen, um überflüssige iProperties zu entfernen
'**********************************************************************************************
Sub DeleteUserProperties(ByVal doc As Document, Suchtext As String)
'Definition der Gruppierung / des Reiters mit den iPproperties
oCustomPropertySet = doc.PropertySets.Item("Inventor User Defined Properties")

'Suche in allen iPproperties in der Gruppierung / im Reiter
For Each oCustProp In oCustomPropertySet
'Lösche das benutzerdefinierte iProperty, das den Suchtext enthält
If oCustProp.name.contains(Suchtext) Then
'MessageBox.Show("Das Property im Document " & GetDisplayName(doc) & " enthält den Suchtext " & Suchtext & " und wird gelöscht.", "Kontrolle", MessageBoxButtons.OK, MessageBoxIcon.Information)
oCustProp.Delete
End If
Next
End Sub

'****************************************
'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 12. Mai. 2025 editiert.]

[Diese Nachricht wurde von FroSte am 12. Mai. 2025 editiert.]

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

---

Richtige_iProps.jpg Falsche_iProps.jpg

Hier noch zwei Screenshots von den iProperties.
Grün sind die Angaben mit der korrekten "Übersetzung" entsprechend der Auswahl in den Benutzerparametern --> hier wurden die Benutzerparameter nicht gelöscht und wieder neu angelegt!
Rot sind die Angaben mit der falschen "Übersetzung", die nicht der Auswahl in den Benutzerparametern entspricht --> hier wurden die Benutzerparameter einmal gelöscht und wieder neu angelegt!

[Diese Nachricht wurde von FroSte am 12. Mai. 2025 editiert.]

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