Code:
'http://ww3.cad.de/foren/ubb/Forum137/HTML/001807.shtml#000006 'http://ww3.cad.de/foren/ubb/Forum137/HTML/001807.shtml#000006
Sub CATMain()
Oeffnen_Zeich
HAUPT_SUB 'Schleife Partname und Exemplarname werden aufgerufen
Clear
Speicher
DATEI_gleich_PARTN
End Sub
Sub Oeffnen_Zeich
CATIA.DisplayFileAlerts = False 'Fehlermeldungen ausschalten'
sInputFile = CATIA.FileSelectionBox("Product auswaehlen und ab geht's!", "*.CATProduct", CatFileSelectionModeOpen)
'########################################### Alle Zeichnungen Oeffen ##################################################
Pfad = Left(sInputFile, InStrRev(sInputFile, "\") )
'MsgBox "fertig !" & vbCrLf & Pfad
Dim oFileSystem As INFITF.FileSystem
Set oFileSystem = CATIA.FileSystem
Dim oFolder As INFITF.Folder
Set oFolder = oFileSystem.GetFolder (Pfad)
Dim FileSep As String
FileSep = oFileSystem.FileSeparator
Dim i As Long
Dim j as Variant
Dim oFile As INFITF.File
Dim oActiveDoc As DrawingDocument
For i = 1 To oFolder.Files.Count
Set oFile = oFolder.Files.Item(i)
If Right(oFile.Name, 10) = "CATDrawing" Then
Set oActiveDoc = CATIA.Documents.Open(oFolder.Path + FileSep + oFile.Name)
For j = 1 to oActiveDoc.Sheets.Count
Next
End If
Next
'############################################ Product Oeffnen ############################################################
Set oDoc = CATIA.Documents.Open(sInputFile)
'#############################################################################################################
End Sub
Sub Clear
Dim oSel as Selection
Set oSel = CATIA.ActiveDocument.Selection
oSel.Clear
End Sub
Sub HAUPT_SUB()
origstr = Inputbox ("Eingeben welcher Name oder Nummer ersetzt werden soll!!! ", "Suche und Ersetze (Suche)")
newstr = Inputbox ("Zu ersetzenden Namen oder Nummer eingeben", "Suche und Ersetze (Ersetze)")
Set actProd = CATIA.ActiveDocument.Product
traverse actProd, origstr, newstr
Set oMainProduct = CATIA.ActiveDocument.product
Dim oMainProducts As Products
Set oMainproducts = oMainProduct.Products
Umbenennen oMainProducts
End Sub
Sub Clear
Dim oSel as Selection
Set oSel = CATIA.ActiveDocument.Selection
oSel.Clear
End Sub
Sub traverse (Prod, origstr, newstr)
set refp = Prod.ReferenceProduct
if instr(refp.PartNumber, origstr) then
newpnum = Replace(refp.PartNumber, origstr, newstr)
refp.PartNumber = newpnum
end if
Set prods = Prod.Products
pc = prods.Count
If pc > 0 then
For i = 1 to pc
traverse prods.Item(i), origstr, newstr
Next
End If
End Sub
Sub Umbenennen(oProducts As Products)
Dim oPartName As String
Dim oName As String
Dim i As Long
For x = 1 to oProducts.Count
Set oInstance = oProducts.Item(x)
oNumber = oInstance.PartNumber
oName = oInstance.Name
i=0
Do
On Error Resume Next
i = i+1
If i>1000 Then ' Zahl soll angepasst werden
Exit Do
End If
oInstance.Name = oNumber & "." & i
If Err.Number = 0 Then
Umbenennen oProducts.Item(x).ReferenceProduct.Products
Exit Do
ElseIf Err.Number = -2147467259 Then
Err.Clear
Err.Number = 0
Else
Exit Do
End If
Loop
If oInstance.Products.Count > 0 Then
Umbenennen oInstance.Products
End If
Next
End Sub
Sub Speicher()
Dim Shell As Object
Dim Ordner As String
Set Shell = CreateObject("Shell.Application")
EingabeSP = Shell.BrowseForFolder(0, "Bitte geben Sie Speicherort ein. Jetzt mach hin ich warte! ", 0).Self.Path
'#############################################################################################################
'__________________________________________________________________________________
'_____________Abfrage Selektierte Elemente_____________________________________________
'Dim UserSelektion As Selection
' Set UserSelektion = productDocument1.Selection
Dim UserSelektion As Selection
Set productDocument1 = CATIA.ActiveDocument
Set UserSelektion = productDocument1.Selection
UserSelektion.Search "(CATAsmSearch.Part+(CATAsmSearch.Product)),all"
'Dim UserSelektion As Selection
'Set UserSelektion = CATIA.ActiveDocument.Selection
'If UserSelektion.Count > 0 Then
For I = 1 to UserSelektion.Count
'MsgBox(UserSelektion.Item(I).Value.Name)
Name = (UserSelektion.Item(I).Value.ReferenceProduct.Name) 'Name = (UserSelektion.Item(I).Value.Name) 'product1.PartNumber
'__________________________________________________________________________________
'_____________Zuordnung____________________________________________________________
VAR_pfad = EingabeSP
Set productDocument1 = CATIA.ActiveDocument
'Set Name = UserSelektion productDocument1.Product
Datei = VAR_pfad & "\" & Name
'__________________________________________________________________________________
'_____________Speicher Befehl Aktiver Fenster___________________________________________
'CATIA.ActiveDocument.SaveAs Datei
'__________________________________________________________________________________
'_____________Abfrage Selektierte Elemente zum Speichen_________________________________
Dim SelectedProduct As Product
Set SelectedProduct = CATIA.ActiveDocument.Selection.Item2(I).Value
Dim doc As Document
Set doc = SelectedProduct.ReferenceProduct.Parent
'__________________________________________________________________________________
'_____________Speicher Befehl Selektierte Elemente ______________________________________
CATIA.DisplayFileAlerts = False
'If TypeName(doc) = PartDocument then doc.SaveAs Datei
doc.SaveAs Datei
'__________________________________________________________________________________
'_____________Informations Speicherbox______________________________________
'Dim Box, Speicher As Long
'MsgBox "Das Dokument wird gespeichert:" & Chr (13) & Chr (10) & VAR_pfad & "\" & Name & "",64, "GESPEICHERT"
'__________________________________________________________________________________
Next
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, ".") - 1)
BenennTXT = Right(vTXT, Len(vTXT) - 18) 'Right Left
PosTXT1 = Left(vTXT, InStrRev(vTXT, "_") - 1)
PosTXT2 = Right(PosTXT1, Len(PosTXT1) - 14) 'Right Left
AuftragNrTXT1 = Left(PosTXT1, Len(PosTXT1) - 9) 'Right Left
bgTXT1 = Left(PosTXT1, Len(PosTXT1) - 5) 'Right Left
bgTXT2 = Right(bgTXT1, Len(bgTXT1) - 9) 'Right Left
'AuftragNr-ZSB = Left(vTXT, InStrRev(vTXT, "_") - 1) 'Right Left
'________________________________________________________________________________________
'__________________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 = BenennTXT
Z = 1
End If
If oText.Name = "Pos" Then
oText.Text = PosTXT2
Z = 1
End If
If oText.Name = "Auftrag" Then
oText.Text = AuftragNrTXT1
Z = 1
End If
If oText.Name = "BG" Then
oText.Text = bgTXT2
Z = 1
End If
If oText.Name = "TitleBlock_Text_Zeich-Nr" Then
oText.Text = PosTXT1
Z = 1
End If
'_________________________________ ZSB _____________________________________________________
If oText.Name = "Zeich-Nr" Then
oText.Text = PosTXT1
Z = 1
End If
If oText.Name = "TitleBlock_Text_Number" Then
oText.Text = vTXT
Z = 1
End If
If oText.Name = "TitleBlock_Text_Zeich-Nr" Then
oText.Text = PosTXT1
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 DATEI_gleich_PARTN
Dim Eingabe As String
sInputFile = CATIA.FileSelectionBox("Product auswählen", "*.CATProduct", CatFileSelectionModeOpen)
Pfad = Left(sInputFile, InStrRev(sInputFile, "\") )
Dim oFileSystem As INFITF.FileSystem
Set oFileSystem = CATIA.FileSystem
Dim oFolder As INFITF.Folder
' Verzeichnisname für CATIA-Part
Set oFolder = oFileSystem.GetFolder (Pfad)
Dim FileSep As String
FileSep = oFileSystem.FileSeparator
Dim i As Long
Dim j as Variant
Dim oFile As INFITF.File
Dim oActiveDoc As DrawingDocument
'Dim BackView As DrawingView
'Dim oText As DrawingText
For i = 1 To oFolder.Files.Count
Set oFile = oFolder.Files.Item(i)
If Right(oFile.Name, 7) = "CATPart" Then
Set oActiveDoc = CATIA.Documents.Open(oFolder.Path + FileSep + oFile.Name)
On Error Resume Next
Dim document As document
Dim splitname As string
Set document = CATIA.ActiveDocument
splitname = Split(document.Name, ".")
Set pro = document.Product
pro.PartNumber = splitname(0)
oActiveDoc.Save
oActiveDoc.Close
End If
'For i = 1 To oFolder.Files.Count
Set oFile = oFolder.Files.Item(i)
If Right(oFile.Name, 10) = "CATProduct" Then
Set oActiveDoc = CATIA.Documents.Open(oFolder.Path + FileSep + oFile.Name)
'Dim document As document
'Dim splitname As string
Set document = CATIA.ActiveDocument
splitname = Split(document.Name, ".")
Set pro = document.Product
pro.PartNumber = splitname(0)
oActiveDoc.Save
oActiveDoc.Close
End If
Next
End sub
Foren auf CAD.de (alle Foren)
| 
