ednagc2002
Mechanical
I added new properties to my part like Material, Department, etc. and gave them values.
Now I made the drawing from this part with some Textboxes. I want a macro that displays the values of my properties in this tex tboxs.
I found a Makro that is very similar from what I need, though it acces the Name of the part and the name of the file, not the properties.
They used this code to acces this ones:
vTXT = Left(oName, InStrRev(oName, ".CAT") - 1)
Name_1 = mid(vTXT, InStrRev(vTXT, "_") +1) 'Right Left Mid
Namex = Left(vTXT, InStrRev(vTXT, "_") -1) 'Right Left Mid
Name_2 = mid(Namex, InStrRev(Namex, "_") +1) 'Right Left Mid
Is there something like this to acces the properties?
Thank you!
here is the whole Code:
Sub CATMain()
If CATIA.Documents.Count = 0 Then
Box = MsgBox("Es wurde kein aktives Dokument identifiziert" + Chr(10) + "Bitte oeffnen Sie zuerst ein Dokument und starten Sie dann das Makro erneut", vbInformation, "Hinweis")
Exit Sub
End If
For i = 1 To CATIA.Documents.Count
Dim oDocument As Document
If CATIA.Documents.Count = 0 Then
Exit Sub
End If
Set oDocument = CATIA.ActiveDocument
If TypeName(oDocument) = "PartDocument" Then
PartDoc
If ErrorReturn = 1 Then
Exit Sub
End If
Set oDocument = CATIA.ActiveDocument
oDocument.Close
End If
If CATIA.Documents.Count = 0 Then
Exit Sub
End If
Set oDocument = CATIA.ActiveDocument
If TypeName(oDocument) = "ProductDocument" Then
ProductDoc
If ErrorReturn = 1 Then
Exit Sub
End If
Set oDocument = CATIA.ActiveDocument
oDocument.Close
End If
If CATIA.Documents.Count = 0 Then
Exit Sub
End If
Set oDocument = CATIA.ActiveDocument
If TypeName(oDocument) = "DrawingDocument" Then
'__________________Ansicht bestimmen_________________________________
Dim oDrwDocument As Document
Set oDrwDocument = CATIA.ActiveDocument
Dim oDrwSheets As DrawingSheets
Set oDrwSheets = oDrwDocument.Sheets
Dim oDrwSheet As DrawingSheet
oDrwDocument.Sheets.Item(1).Activate
Set oDrwSheet = oDrwSheets.ActiveSheet
Dim oViews As DrawingViews
Set oViews = oDrwSheet.Views
Dim oView As DrawingView
Set oView = oViews.ActiveView
oView.Activate
'_______________________________________________________________
'__________________________Dateipfad LESEN___________________________________________
If oDrwSheets.Parent.Path = "" Then
Mldg_1 = "Die aktive Zeichnung hat keine externen Refenzen"
Mldg_2 = "Bitte schließen Sie alle Zeichnung die nicht auf CATParts oder CATProduct verlinkt sind und starten Sie das Makro erneut"
Mldg_3 = "Das Makro wird nun beendet!"
Stil = vbOKOnly + vbCritical
Titel = "Abbruch"
Box = MsgBox(Mldg_1 + Chr(10) + Mldg_2 + Chr(10) + Mldg_3, Stil, Titel)
Exit Sub
End If
Set ProductDrawn = oDrwSheet.Views.Item("Vorderansicht").GenerativeBehavior.Document
oPath = ProductDrawn.Parent.FullName
oName = ProductDrawn.Parent.Name
'__________________________________ STRING zerlegen ____________________________
On Error Resume Next
vTXT = Left(oName, InStrRev(oName, ".CAT") - 1)
Name_1 = mid(vTXT, InStrRev(vTXT, "_") +1) 'Right Left Mid
Namex = Left(vTXT, InStrRev(vTXT, "_") -1) 'Right Left Mid
Name_2 = mid(Namex, InStrRev(Namex, "_") +1) 'Right Left Mid
'________________________________________________________________________________________
'__________________Auf Blatt 2 wechseln_________________________________
Set oDraw = CATIA.ActiveDocument ' Zeichnung als aktives Dokument bestimmen
Set oSheets = oDraw.Sheets
oDraw.Sheets.Item(1).Activate
Set oSheet = oSheets.ActiveSheet
oSheet.Activate
Dim j As Integer
Dim oText As DrawingText
Dim ocText As DrawingTexts
'________________________________________________________________________________________
'__________________Alle Views ablaufen und nach Texten suchen_________________________________
For k = 1 To oDraw.Sheets.Count 'Schleife fuer alle Sheets
Set oSheet = oDraw.Sheets.Item(k)
'If oSheet.IsDetail Then 'Ist das Sheet kein Detail-Sheet?
For j = 1 To oSheet.Views.Count 'Schleife fuer alle Views im Sheet
Set oView = oSheet.Views.Item(j)
Set ocText = oView.Texts
Z = 0
For s = 1 To ocText.Count
Set oText = ocText.Item(s)
If oText.Name = "Benennung" Then
oText.Text = Name_1
Z = 1
End If
if oText.Name = "Zeich-Nr" Then
oText.Text = Name_2
Z = 1
End If
Next
Next
'End If
Next
'Box = MsgBox ( Z)
'________________________________________________________________________________
'______________________________ Text suchen und ueberschreiben __________________________________
'________________________________________________________________________________________
'__________________In den Vordergrund wecheln_________________________________
Dim ErrorFrame As Integer
Set oDraw = CATIA.ActiveDocument ' Zeichnung als aktives Dokument bestimmen
Set oSheets = oDraw.Sheets
oDraw.Sheets.Item(1).Activate
Set oSheet = oSheets.ActiveSheet
oSheet.Activate
Set oViews = oSheet.Views
oSheet.Views.Item(1).Activate ' BLATT001 aktivieren
Set oView = oViews.Item(1)
oView.Activate
ErrorFrame = 0
If Z <> 1 Then
'Box = MsgBox("Der passende Zeichnungsrahmen wurde nicht gefunden, bzw. die Textfelder im Schriftfeld wurden umbenannt." + Chr(10) + "Bitte tauschen Sie den Rahmen gegen aktuellen Zeichnungsrahmen mit aktuellen Schriftfeld", vbCritical, "Abbruch")
ErrorFrame = 1
End If
'________________________________________________________________________________________
'__________________________________Aufteilung Dateiname & Dateipfad____________________________
Dim nName As String
nName = Left(oPath, InStrRev(oPath, ".CAT") - 1)
'________________________________________________________________________________________
'__________________________________Zeichnung speichern____________________________
CATIA.DisplayFileAlerts = False
Datei = nName & ".CATDrawing"
CATIA.ActiveDocument.SaveAs (Datei)
'________________________________________________________________________________________
'__________________________________Message Box____________________________
Dim oFile As String
Dim nDoc As Document
If ErrorFrame = 1 Then
Mldg_1 = "Die Zeichnung wurde erfolgreich gespeichert."
Mldg_2 = "Zeichnungspfad: " & Datei
'Mldg_3 = "Das Schriftfeld konnte nicht aktualisiert werden!"
Stil = vbOKOnly + vbInformation
Titel = "Hinweis"
'Box = MsgBox(Mldg_1 + Chr(10) + Chr(10) + Mldg_2 + Chr(10) + Chr(10) + Mldg_3, Stil, Titel)
Else
Mldg_1 = "Die Zeichnung wurde erfolgreich gespeichert."
Mldg_2 = "Zeichnungspfad: " & Datei
'Mldg_4 = "Das Schriftfeld wurde erfolgreich synchronisiert!"
Stil = vbOKOnly + vbInformation
Titel = "Hinweis"
'Box = MsgBox(Mldg_1 + Chr(10) + Chr(10) + Mldg_2 + Chr(10) + Chr(10) + Mldg_4, Stil, Titel)
End If
'________________________________________________________________________________________
'__________________________________Zeichnung schließen____________________________
'________________________________________________________________________________________
End If
Next
'________________________________________________________________________________________
'__________________________________Fehlerbehandlungen____________________________
End Sub
Sub PartDoc()
Dim oDoc As PartDocument
Dim Name As String
ErrorReturn = 0
Set oDoc = CATIA.ActiveDocument
Name = oDoc.Path
If Name = "" Then
sDoc = CATIA.FileSelectionBox("Datei Speichern", "*.CATPart", CatFileSelectionModeSave)
If sDoc = "" Then
Box = MsgBox("Sie haben das Speichern des Dokumentes abgebrochen" + Chr(10) + "Das Makro kann nicht weiter ausgefuehrt werden!" + Chr(10) + "Bitte speichern Sie das Dokument ab und starten Sie das Makro erneut", vbCritical, "Abbruch")
ErrorReturn = 1
Exit Sub
End If
oDoc.SaveAs (sDoc)
Else
oDoc.Save
End If
End Sub
Sub ProductDoc()
Dim oDoc As ProductDocument
Dim Name As String
ErrorReturn = 0
Set oDoc = CATIA.ActiveDocument
Name = oDoc.Path
If Name = "" Then
sDoc = CATIA.FileSelectionBox("Datei Speichern", "*.CATProduct", CatFileSelectionModeSave)
If sDoc = "" Then
Box = MsgBox("Sie haben das Speichern des Dokumentes abgebrochen" + Chr(10) + "Das Makro kann nicht weiter ausgefuehrt werden!" + Chr(10) + "Bitte speichern Sie das Dokument ab und starten Sie das Makro erneut", vbCritical, "Abbruch")
ErrorReturn = 1
Exit Sub
End If
oDoc.SaveAs (sDoc)
Else
oDoc.Save
End If
End Sub
Sub Zeichnung()
End Sub
Now I made the drawing from this part with some Textboxes. I want a macro that displays the values of my properties in this tex tboxs.
I found a Makro that is very similar from what I need, though it acces the Name of the part and the name of the file, not the properties.
They used this code to acces this ones:
vTXT = Left(oName, InStrRev(oName, ".CAT") - 1)
Name_1 = mid(vTXT, InStrRev(vTXT, "_") +1) 'Right Left Mid
Namex = Left(vTXT, InStrRev(vTXT, "_") -1) 'Right Left Mid
Name_2 = mid(Namex, InStrRev(Namex, "_") +1) 'Right Left Mid
Is there something like this to acces the properties?
Thank you!
here is the whole Code:
Sub CATMain()
If CATIA.Documents.Count = 0 Then
Box = MsgBox("Es wurde kein aktives Dokument identifiziert" + Chr(10) + "Bitte oeffnen Sie zuerst ein Dokument und starten Sie dann das Makro erneut", vbInformation, "Hinweis")
Exit Sub
End If
For i = 1 To CATIA.Documents.Count
Dim oDocument As Document
If CATIA.Documents.Count = 0 Then
Exit Sub
End If
Set oDocument = CATIA.ActiveDocument
If TypeName(oDocument) = "PartDocument" Then
PartDoc
If ErrorReturn = 1 Then
Exit Sub
End If
Set oDocument = CATIA.ActiveDocument
oDocument.Close
End If
If CATIA.Documents.Count = 0 Then
Exit Sub
End If
Set oDocument = CATIA.ActiveDocument
If TypeName(oDocument) = "ProductDocument" Then
ProductDoc
If ErrorReturn = 1 Then
Exit Sub
End If
Set oDocument = CATIA.ActiveDocument
oDocument.Close
End If
If CATIA.Documents.Count = 0 Then
Exit Sub
End If
Set oDocument = CATIA.ActiveDocument
If TypeName(oDocument) = "DrawingDocument" Then
'__________________Ansicht bestimmen_________________________________
Dim oDrwDocument As Document
Set oDrwDocument = CATIA.ActiveDocument
Dim oDrwSheets As DrawingSheets
Set oDrwSheets = oDrwDocument.Sheets
Dim oDrwSheet As DrawingSheet
oDrwDocument.Sheets.Item(1).Activate
Set oDrwSheet = oDrwSheets.ActiveSheet
Dim oViews As DrawingViews
Set oViews = oDrwSheet.Views
Dim oView As DrawingView
Set oView = oViews.ActiveView
oView.Activate
'_______________________________________________________________
'__________________________Dateipfad LESEN___________________________________________
If oDrwSheets.Parent.Path = "" Then
Mldg_1 = "Die aktive Zeichnung hat keine externen Refenzen"
Mldg_2 = "Bitte schließen Sie alle Zeichnung die nicht auf CATParts oder CATProduct verlinkt sind und starten Sie das Makro erneut"
Mldg_3 = "Das Makro wird nun beendet!"
Stil = vbOKOnly + vbCritical
Titel = "Abbruch"
Box = MsgBox(Mldg_1 + Chr(10) + Mldg_2 + Chr(10) + Mldg_3, Stil, Titel)
Exit Sub
End If
Set ProductDrawn = oDrwSheet.Views.Item("Vorderansicht").GenerativeBehavior.Document
oPath = ProductDrawn.Parent.FullName
oName = ProductDrawn.Parent.Name
'__________________________________ STRING zerlegen ____________________________
On Error Resume Next
vTXT = Left(oName, InStrRev(oName, ".CAT") - 1)
Name_1 = mid(vTXT, InStrRev(vTXT, "_") +1) 'Right Left Mid
Namex = Left(vTXT, InStrRev(vTXT, "_") -1) 'Right Left Mid
Name_2 = mid(Namex, InStrRev(Namex, "_") +1) 'Right Left Mid
'________________________________________________________________________________________
'__________________Auf Blatt 2 wechseln_________________________________
Set oDraw = CATIA.ActiveDocument ' Zeichnung als aktives Dokument bestimmen
Set oSheets = oDraw.Sheets
oDraw.Sheets.Item(1).Activate
Set oSheet = oSheets.ActiveSheet
oSheet.Activate
Dim j As Integer
Dim oText As DrawingText
Dim ocText As DrawingTexts
'________________________________________________________________________________________
'__________________Alle Views ablaufen und nach Texten suchen_________________________________
For k = 1 To oDraw.Sheets.Count 'Schleife fuer alle Sheets
Set oSheet = oDraw.Sheets.Item(k)
'If oSheet.IsDetail Then 'Ist das Sheet kein Detail-Sheet?
For j = 1 To oSheet.Views.Count 'Schleife fuer alle Views im Sheet
Set oView = oSheet.Views.Item(j)
Set ocText = oView.Texts
Z = 0
For s = 1 To ocText.Count
Set oText = ocText.Item(s)
If oText.Name = "Benennung" Then
oText.Text = Name_1
Z = 1
End If
if oText.Name = "Zeich-Nr" Then
oText.Text = Name_2
Z = 1
End If
Next
Next
'End If
Next
'Box = MsgBox ( Z)
'________________________________________________________________________________
'______________________________ Text suchen und ueberschreiben __________________________________
'________________________________________________________________________________________
'__________________In den Vordergrund wecheln_________________________________
Dim ErrorFrame As Integer
Set oDraw = CATIA.ActiveDocument ' Zeichnung als aktives Dokument bestimmen
Set oSheets = oDraw.Sheets
oDraw.Sheets.Item(1).Activate
Set oSheet = oSheets.ActiveSheet
oSheet.Activate
Set oViews = oSheet.Views
oSheet.Views.Item(1).Activate ' BLATT001 aktivieren
Set oView = oViews.Item(1)
oView.Activate
ErrorFrame = 0
If Z <> 1 Then
'Box = MsgBox("Der passende Zeichnungsrahmen wurde nicht gefunden, bzw. die Textfelder im Schriftfeld wurden umbenannt." + Chr(10) + "Bitte tauschen Sie den Rahmen gegen aktuellen Zeichnungsrahmen mit aktuellen Schriftfeld", vbCritical, "Abbruch")
ErrorFrame = 1
End If
'________________________________________________________________________________________
'__________________________________Aufteilung Dateiname & Dateipfad____________________________
Dim nName As String
nName = Left(oPath, InStrRev(oPath, ".CAT") - 1)
'________________________________________________________________________________________
'__________________________________Zeichnung speichern____________________________
CATIA.DisplayFileAlerts = False
Datei = nName & ".CATDrawing"
CATIA.ActiveDocument.SaveAs (Datei)
'________________________________________________________________________________________
'__________________________________Message Box____________________________
Dim oFile As String
Dim nDoc As Document
If ErrorFrame = 1 Then
Mldg_1 = "Die Zeichnung wurde erfolgreich gespeichert."
Mldg_2 = "Zeichnungspfad: " & Datei
'Mldg_3 = "Das Schriftfeld konnte nicht aktualisiert werden!"
Stil = vbOKOnly + vbInformation
Titel = "Hinweis"
'Box = MsgBox(Mldg_1 + Chr(10) + Chr(10) + Mldg_2 + Chr(10) + Chr(10) + Mldg_3, Stil, Titel)
Else
Mldg_1 = "Die Zeichnung wurde erfolgreich gespeichert."
Mldg_2 = "Zeichnungspfad: " & Datei
'Mldg_4 = "Das Schriftfeld wurde erfolgreich synchronisiert!"
Stil = vbOKOnly + vbInformation
Titel = "Hinweis"
'Box = MsgBox(Mldg_1 + Chr(10) + Chr(10) + Mldg_2 + Chr(10) + Chr(10) + Mldg_4, Stil, Titel)
End If
'________________________________________________________________________________________
'__________________________________Zeichnung schließen____________________________
'________________________________________________________________________________________
End If
Next
'________________________________________________________________________________________
'__________________________________Fehlerbehandlungen____________________________
End Sub
Sub PartDoc()
Dim oDoc As PartDocument
Dim Name As String
ErrorReturn = 0
Set oDoc = CATIA.ActiveDocument
Name = oDoc.Path
If Name = "" Then
sDoc = CATIA.FileSelectionBox("Datei Speichern", "*.CATPart", CatFileSelectionModeSave)
If sDoc = "" Then
Box = MsgBox("Sie haben das Speichern des Dokumentes abgebrochen" + Chr(10) + "Das Makro kann nicht weiter ausgefuehrt werden!" + Chr(10) + "Bitte speichern Sie das Dokument ab und starten Sie das Makro erneut", vbCritical, "Abbruch")
ErrorReturn = 1
Exit Sub
End If
oDoc.SaveAs (sDoc)
Else
oDoc.Save
End If
End Sub
Sub ProductDoc()
Dim oDoc As ProductDocument
Dim Name As String
ErrorReturn = 0
Set oDoc = CATIA.ActiveDocument
Name = oDoc.Path
If Name = "" Then
sDoc = CATIA.FileSelectionBox("Datei Speichern", "*.CATProduct", CatFileSelectionModeSave)
If sDoc = "" Then
Box = MsgBox("Sie haben das Speichern des Dokumentes abgebrochen" + Chr(10) + "Das Makro kann nicht weiter ausgefuehrt werden!" + Chr(10) + "Bitte speichern Sie das Dokument ab und starten Sie das Makro erneut", vbCritical, "Abbruch")
ErrorReturn = 1
Exit Sub
End If
oDoc.SaveAs (sDoc)
Else
oDoc.Save
End If
End Sub
Sub Zeichnung()
End Sub