Code:
Public ErrorReturn As Integer
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
Name_3 = UseName = CATIA.SystemService.Environ("USERNAME")
'Msgbox UseName
if UseName = "K.siebert" Then
NameU = "Sieb" + Name_3
end if
'#################################### 2 MessageBoxen anzeigen
' msgbox Name_1
' msgbox Name_2
'#################################### 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
if oText.Name = "Datum" Then
oText.Text = Name_3 = CStr(Date)
'Msgbox Name_3
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
' CATIA.ActiveDocument.Close
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
Foren auf CAD.de (alle Foren)
| 
Sei Schlau bleib Dumm !!?!! 
Danke viel mals und ich entschuldige mich noch mal für die mehrere Fragen. 
