Hallo ,
ich möchte mit Hilfe von Makro Information in Zeichnungskopf eintragen.
Parameter aus 3D habe ich schon drin. Jetzt brauche ich die Information aus dem Zeichnung:
Sheet of Sheets (1 of 2); Scale (1:1) ; Format Grösse ( A3) ; Aktuelle Catia Version (V5R22);
Leider weiß es nicht wir soll ich die in Macro zeigen.
Für "Sheets" habe ich teilweise geschafft aber auch nicht zu ende.
Kann hier jemand helfen ?
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
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...
Exit Sub
End If
Set oDrwSheet = oDrwDoc.Sheets.Item(1) 'Blatt 1 ansprechen/zuweisen - ist immer vorhanden, keine Fehlerbehandlung erforderlich
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
Exit Sub
End If
Set oCatDoc = oDrwView.GenerativeBehavior.Document.Parent 'pruefen ob verlinkte Dokument vorhanden ist
Set oProd = oCatDoc.Product
'######################################################
' parameter aus 3D
'######################################################
Set oParam = oProd.Parameters.item("Benennung")
Set oDrwText = oDrwSheet.Views.Item(2).Texts.GetItem("zkwe15")
oDrwText.Text = ""
oDrwText.InsertVariable 0, 0, oParam
'####################################
Set oParam = oProd.Parameters.item("Material_Nummer")
Set oDrwText = oDrwSheet.Views.Item(2).Texts.GetItem("zkw027")
oDrwText.Text = ""
oDrwText.InsertVariable 0, 0, oParam
'####################################
' parameter aus drawing
'####################################
Dim AktuelleDrawing 'As DrawingDocument
Set AktuelleDrawing = CATIA.ActiveDocument
MsgBox (AktuelleDrawing.Sheets.count) ' alle blaeter , zeigt richtig
Set oDrwText = oDrwSheet.Views.Item(2).Texts.GetItem("zkw024")
oDrwText.Text = ""
oDrwText.InsertVariable 0, 0, MsgBox (AktuelleDrawing.Sheets.count) ' hier leider keine Eingabe
If Err.Number <> 0 Then
MsgBox "Irgendwas ist schiefgelaufen."
End If
On Error GoTo 0
End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP