---

Hallo ,

Ich habe eine Macro , da werden Parameter von 3D -Part in Zeichnungskopf eingetragen.

Das klappt alles gut mit Part leider nicht mit Product( da werden Parameter aus dem ersten Part und nicht aus dem Product übertragen .
Kann hier jemand helfen , wir kann ich den Product ( Baugruppe)abfragen ?

Sub CATMain()
Dim oDrwDoc As DrawingDocument
Dim oDrwSheet As DrawingSheet
Dim oSheets As DrawingSheets
Dim oDrwView As DrawingView
Dim oCatDoc As Document
Dim oDrwText As DrawingText
Dim oProd As Product
Dim oParam As Parameter
Dim Wert As String
Dim TOL As String

On Error Resume Next

Set oDrwDoc = CATIA.ActiveDocument          'pruefen ob ein Zeichnungsdokument geladen/aktiv ist
If Err.Number <> 0 Then  'wenn keine Zeichnung geladen/aktiv ist...
    MsgBox (" no document  open ")
    Exit Sub
End If

Set oDrwSheet = oDrwDoc.Sheets.Item(1)
Set oDrwView = oDrwSheet.Views.Item(3)      'pruefen ob eine Geometrieansicht vorhanden ist - Item(1) = Arbeitsansicht, Item(2) = Hintergrundansicht
If Err.Number <> 0 Then 'wenn keine Geometrieansicht vorhanden ist
MsgBox (" No View on Sheet 1")
    Exit Sub
End If

Set oCatDoc = oDrwView.GenerativeBehavior.Document.Parent  'pruefen ob verknuepftes Dokument vorhanden ist
Set oProd = oCatDoc.Product

'################3D Parameter####################################
Set oParam = oProd.Parameters.item("Benennung")
If Err.Number <> 0 Then                    'wenn keine Parameter da
    MsgBox (" Parameter fehlt")
    Exit Sub
End If
'MsgBox (oParam.value)
Set oDrwText = oDrwSheet.Views.Item(2).Texts.GetItem("zkwe15")
If Err.Number <> 0 Then                    'wenn keine Text da
    MsgBox (" Text in Zechnungs  fehlt")
    Exit Sub
End If
  oDrwText.Text = ""
  oDrwText.InsertVariable 0, 0, oParam
 
 
'####################################

Set oParam = oProd.Parameters.item("Material_Nummer")
If Err.Number <> 0 Then                    'wenn keine Parameter da
    MsgBox (" Parameter fehlt")
    Exit Sub
End If
'MsgBox (oParam.value)
Set oDrwText = oDrwSheet.Views.Item(2).Texts.GetItem("zkw027")
If Err.Number <> 0 Then                    'wenn keine Text da
    MsgBox (" Text in Zechnungs  fehlt")
    Exit Sub
End If
  oDrwText.Text = ""
  oDrwText.InsertVariable 0, 0, oParam
'####################################

End Sub

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

---

Servus
Schau mal hier.

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

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

---

Hallo, so sollte es bei einem Product funktionieren:

Set oParam = oProd.ReferenceProduct.Parameters.item("Benennung")

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

---

da habe ich jetzt verstanden
Makro geht durch alle Teile : part1, part2... als letzte product.
Sobald ein Parameter findet zeigt diese

Alle teile und Baugruppe haben gleiche Parameter.("Material_Nummer" und " Benennug")
Mein Zeichnung hat Verbindung nur zum einen Product (main Product).

Wie kann ich diesen main Product ansprechen?

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

---

Servus
Hast du meinen verlinkte Diskussion gelesen?
Schon mal mit dem .RootParameterSet.DirectParameters probiert? (bitte mit dem Watchfenster im VBA Editor arbeiten)

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

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

---

so habe ich probiert leider keinen Ergebniss

Set oParam = oProd.Parameters.RootParameterSet.DirectParameters("Benennung")
MsgBox (oParam.value)

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

---

Servus

Wie wäre es mit

Code:

---

Set oParam = oProd.Parameters.RootParameterSet.DirectParameters.item("Benennung")

---

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

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

---

leider ist immer noch was nicht richtig

Sub CATMain()
Dim oDrwDoc As DrawingDocument
Dim oDrwSheet As DrawingSheet
Dim oSheets As DrawingSheets
Dim oDrwView As DrawingView
Dim oCatDoc As Document
Dim oDrwText As DrawingText
Dim oProd As Product
Dim oParam As ParameterSet
Dim Wert As String
Dim TOL As String

On Error Resume Next

Set oDrwDoc = CATIA.ActiveDocument          'Zeichnungsdokument geladen/aktiv ist
Set oDrwSheet = oDrwDoc.Sheets.Item(1)
Set oDrwView = oDrwSheet.Views.Item(3)      ' Geometrieansicht vorhanden ist - Item(1) = Arbeitsansicht, Item(2) = Hintergrundansicht
Set oCatDoc = oDrwView.GenerativeBehavior.Document.Parent  'verknuepftes Dokument
Set oProd = oCatDoc.Product

Set oParam = oProd.Parameters.RootParameterSet.DirectParameters.item("Benennung")
MsgBox (oParam.value)

End Sub

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

---

Servus
Bitte:
a) Code in entsprechende Tags posten
b) Systeminfo ergänzen
c) das "On Error Resume Next" rauswerfen, damit du zumindest eine Fehlermeldung bekommst
d) falls möglich den Code/Struktur im VBA-Editor analysieren
e) Wie sieht deine Struktur aus (im Part/CatProduct)? Was hast du alles probiert um den Fehler einzugrenzen?

Gruß
Bernd

EDIT: Falls es sich bei deinem Parameter um UserRefProperties handelt schau zB mal auch hier.

------------------
Warum einfach, wenn es auch kompliziert geht.

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