Hallo zusammen
Ich hoffe, jemand kann mir weiterhelfen.
ich müsste den Namen des Schriftkopfes prüfen, bekomme aber nur eine Fehlermeldung.
Da wir übernomen wurden, sind alle Firmenbenennungen geändert worden. Auch der Name des Zeichnungskopfes in der Zeichnung. Nun Funktioniert das Makro zum Aktualisieren des Zeichnungskopfes nicht mehr. Den alten Zeichnungskopf umbenennen auf den neuen Firmennamen klapp. Wenn ich nun aber eine Zeichnung habe, wo ich nur den Zeichnungskopf aktualisieren muss und bereits den richtigen Namen habe, bekomme ich einen Fehler, da der Umzubenennende Zeichnungskopf nicht gefunden wird. Der Zeichnungsrahmen und die Symbole werden auch ersetzt. Dies funktioniert ohne Probleme.
Ich möchte folgendes Machen. Alter Zeichnungskopf vorhanden, ja/nein.
Wenn ja umbenennen und dann aktualisieren.
Wenn nein, nur aktualisieren.
Ich hatte nie eine Ausbildung auf dem Gebiet und bin mit meinem Kleinstwissen ziemlich am Ende...
Hier ist mein zusammenkopierter Code... (wenn er funktioniert, muss ich dann noch die Codeleichen bereinigen)
----------------------
Sub Zeichnungsressourcen()
'ersetzt die Zeichnungsresourben in der aktuellen Zeichnung durch die der Template
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
If oDrawDoc.TitleBlockDefinitions.Item("SFA") Is Nothing Then
MsgBox "goto sfa"
GoTo SFA
Else
MsgBox "goto andritz"
GoTo ANDRITZ
End If
Exit Sub
SFA: '******************************************************** SFA Kopf noch nicht umbenannt
MsgBox "SFA ist da"
' If ThisApplication.ActiveDocumentType = kDrawingDocumentObject Then
Dim ZielDoc As DrawingDocument
Set ZielDoc = ThisApplication.ActiveDocument
Dim Blatt As Sheet
Set Blatt = ZielDoc.ActiveSheet
Dim i, j As Integer
Dim zahl1 As Long
Dim zahl2 As Long
' If SFA_Test = "" Then
' MsgBox "kein SFA"
' Else
' MsgBox "SFA ist da"
' End If
'On Error GoTo ErrorSFA
' Dim oTitleBlockDef As TitleBlockDefinition
' Set oTitleBlockDef = oDrawDoc.TitleBlockDefinitions.Item("SFA")
'vorhandenen Blattformate aus activer Zeichnungsresource löschen
zahl1 = ZielDoc.SheetFormats.Count
For i = 1 To zahl1
' On Error Resume Next
ZielDoc.SheetFormats.Item(zahl1 + 1 - i).Delete
Next
' If oDrawDoc.TitleBlockDefinitions.Item("SFA") = Error Then
' MsgBox "DKein SFA Zeichnungskopf"
Set oDrawDoc = ThisApplication.ActiveDocument
' Dim oTitleBlockDef As TitleBlockDefinition
Set oTitleBlockDef = oDrawDoc.TitleBlockDefinitions.Item("SFA")
MsgBox oTitleBlockDef.Name
oTitleBlockDef.Name = "ANDRITZ"
MsgBox oTitleBlockDef.Name
' Else
' End If
' If oSheet.TitleBlock.Item("SFA A4") Is Nothing Then
Set oDrawDoc = ThisApplication.ActiveDocument
' Dim oTitleBlockDef As TitleBlockDefinition
Set oTitleBlockDef = oDrawDoc.TitleBlockDefinitions.Item("SFA A4")
MsgBox oTitleBlockDef.Name
oTitleBlockDef.Name = "ANDRITZ A4"
MsgBox oTitleBlockDef.Name
' Else
' End If
'vorhandene skizzierte Symbole löschen
On Error Resume Next
Blatt.SketchedSymbolDefinition.Delete
zahl1 = ZielDoc.SketchedSymbolDefinitions.Count
For i = 1 To zahl1
ZielDoc.SketchedSymbolDefinitions.Item(zahl1 + 1 - i).Delete
Next
'Resourcen der Template defenieren und Kopieren
Dim oSketchedSymbolDef As SketchedSymbolDefinition
Dim QuellDoc As DrawingDocument
Set QuellDoc = ThisApplication.Documents.Open("P:\Inventor\00003 - Templates\Inventor SFA 2019\A0-1Q-e.idw")
Dim QuellRahmenA0 As BorderDefinition
Set QuellRahmenA0 = QuellDoc.BorderDefinitions.Item("A0")
Dim ZielRahmenA0 As BorderDefinition
Set ZielRahmenA0 = QuellRahmenA0.CopyTo(ZielDoc, True)
Dim QuellRahmenA1 As BorderDefinition
Set QuellRahmenA1 = QuellDoc.BorderDefinitions.Item("A1")
Dim ZielRahmenA1 As BorderDefinition
Set ZielRahmenA1 = QuellRahmenA1.CopyTo(ZielDoc, True)
Dim QuellRahmenA2 As BorderDefinition
Set QuellRahmenA2 = QuellDoc.BorderDefinitions.Item("A2")
Dim ZielRahmenA2 As BorderDefinition
Set ZielRahmenA2 = QuellRahmenA2.CopyTo(ZielDoc, True)
Dim QuellRahmenA3 As BorderDefinition
Set QuellRahmenA3 = QuellDoc.BorderDefinitions.Item("A3")
Dim ZielRahmenA3 As BorderDefinition
Set ZielRahmenA3 = QuellRahmenA3.CopyTo(ZielDoc, True)
Dim QuellRahmenA4 As BorderDefinition
Set QuellRahmenA4 = QuellDoc.BorderDefinitions.Item("A4")
Dim ZielRahmenA4 As BorderDefinition
Set ZielRahmenA4 = QuellRahmenA4.CopyTo(ZielDoc, True)
' Dim QuellSchriftfeld_quer As TitleBlockDefinition
Set QuellSchriftfeld_quer = QuellDoc.TitleBlockDefinitions.Item("ANDRITZ")
' Dim ZielSchriftfeld_quer As TitleBlockDefinition
Set ZielSchriftfeld_quer = QuellSchriftfeld_quer.CopyTo(ZielDoc, True)
Dim QuellSchriftfeld_hoch As TitleBlockDefinition
Set QuellSchriftfeld_hoch = QuellDoc.TitleBlockDefinitions.Item("ANDRITZ A4")
Dim ZielSchriftfeld_hoch As TitleBlockDefinition
Set ZielSchriftfeld_hoch = QuellSchriftfeld_hoch.CopyTo(ZielDoc, True)
'fügt neue skizzierte Symbole aus Template in die Zeichnungsresourcen des activen Blattes ein
zahl1 = QuellDoc.SketchedSymbolDefinitions.Count
For i = 1 To zahl1
Set oSketchedSymbolDef = QuellDoc.SketchedSymbolDefinitions.Item(i).CopyTo(ZielDoc, True)
Next
QuellDoc.Close
'schaltet Browserleiste wieder ein
ThisApplication.UserInterfaceManager.ShowBrowser = True
' Else: MsgBox ("Ein Schriftfeld kann nur in eine Zeichnung eingefügt werden!")
' End If
Exit Sub
ANDRITZ: '******************************************************** SFA Kopf bereits umbenannt
MsgBox "kein SFA"
' If ThisApplication.ActiveDocumentType = kDrawingDocumentObject Then
' Dim ZielDoc As DrawingDocument
Set ZielDoc = ThisApplication.ActiveDocument
' Dim Blatt As Sheet
Set Blatt = ZielDoc.ActiveSheet
' Dim i, j As Integer
' Dim zahl1 As Long
'vorhandenen Blattformate aus activer Zeichnungsresource löschen
zahl1 = ZielDoc.SheetFormats.Count
For i = 1 To zahl1
On Error Resume Next
ZielDoc.SheetFormats.Item(zahl1 + 1 - i).Delete
Next
'vorhandene skizzierte Symbole löschen
On Error Resume Next
Blatt.SketchedSymbolDefinition.Delete
zahl1 = ZielDoc.SketchedSymbolDefinitions.Count
For i = 1 To zahl1
ZielDoc.SketchedSymbolDefinitions.Item(zahl1 + 1 - i).Delete
Next
'Resourcen der Template defenieren und Kopieren
' Dim oSketchedSymbolDef As SketchedSymbolDefinition
' Dim QuellDoc As DrawingDocument
Set QuellDoc = ThisApplication.Documents.Open("P:\Inventor\00003 - Templates\Inventor SFA 2019\A0-1Q-e.idw")
' Dim QuellRahmenA0 As BorderDefinition
Set QuellRahmenA0 = QuellDoc.BorderDefinitions.Item("A0")
' Dim ZielRahmenA0 As BorderDefinition
Set ZielRahmenA0 = QuellRahmenA0.CopyTo(ZielDoc, True)
' Dim QuellRahmenA1 As BorderDefinition
Set QuellRahmenA1 = QuellDoc.BorderDefinitions.Item("A1")
' Dim ZielRahmenA1 As BorderDefinition
Set ZielRahmenA1 = QuellRahmenA1.CopyTo(ZielDoc, True)
' Dim QuellRahmenA2 As BorderDefinition
Set QuellRahmenA2 = QuellDoc.BorderDefinitions.Item("A2")
' Dim ZielRahmenA2 As BorderDefinition
Set ZielRahmenA2 = QuellRahmenA2.CopyTo(ZielDoc, True)
' Dim QuellRahmenA3 As BorderDefinition
Set QuellRahmenA3 = QuellDoc.BorderDefinitions.Item("A3")
' Dim ZielRahmenA3 As BorderDefinition
Set ZielRahmenA3 = QuellRahmenA3.CopyTo(ZielDoc, True)
' Dim QuellRahmenA4 As BorderDefinition
Set QuellRahmenA4 = QuellDoc.BorderDefinitions.Item("A4")
' Dim ZielRahmenA4 As BorderDefinition
Set ZielRahmenA4 = QuellRahmenA4.CopyTo(ZielDoc, True)
' Dim QuellSchriftfeld_quer As TitleBlockDefinition
' Set QuellSchriftfeld_quer = QuellDoc.TitleBlockDefinitions.Item("SFA")
' Dim ZielSchriftfeld_quer As TitleBlockDefinition
' Set ZielSchriftfeld_quer = QuellSchriftfeld_quer.CopyTo(ZielDoc, True)
' Dim QuellSchriftfeld_quer As TitleBlockDefinition
Set QuellSchriftfeld_quer = QuellDoc.TitleBlockDefinitions.Item("ANDRITZ")
' Dim ZielSchriftfeld_quer As TitleBlockDefinition
Set ZielSchriftfeld_quer = QuellSchriftfeld_quer.CopyTo(ZielDoc, True)
' Dim QuellSchriftfeld_hoch As TitleBlockDefinition
Set QuellSchriftfeld_hoch = QuellDoc.TitleBlockDefinitions.Item("ANDRITZ A4")
' Dim ZielSchriftfeld_hoch As TitleBlockDefinition
Set ZielSchriftfeld_hoch = QuellSchriftfeld_hoch.CopyTo(ZielDoc, True)
'fügt neue skizzierte Symbole aus Template in die Zeichnungsresourcen des activen Blattes ein
zahl1 = QuellDoc.SketchedSymbolDefinitions.Count
For i = 1 To zahl1
Set oSketchedSymbolDef = QuellDoc.SketchedSymbolDefinitions.Item(i).CopyTo(ZielDoc, True)
Next
QuellDoc.Close
'schaltet Browserleiste wieder ein
ThisApplication.UserInterfaceManager.ShowBrowser = True
' Else: MsgBox ("Ein Schriftfeld kann nur in eine Zeichnung eingefügt werden!")
' End If
Exit Sub
End Sub
----------------------
MfG
Stephan
[Diese Nachricht wurde von stephan.lehmann am 16. Apr. 2024 editiert.]
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP