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