---

Hallo,

habe vor ein Makro zu basteln welches überprüft ob das Schriftfeld
aktuell ist, wenn nicht soll es dieses austauschen.

Im gleichen Zug soll das Dokument aktualisiert werden.

Bis hierhin kein Problem...

Code:

---

Sub Save_with_goodies()

    ThisApplication.ActiveDocument.Update
    Dim oControlDef As ControlDefinition
    Set oControlDef = ThisApplication.CommandManager.ControlDefinitions.Item("AIMDUpdatePropsAllInternal")
    oControlDef.Execute
 
    If ThisApplication.ActiveDocument Is Nothing Then
        MsgBox "No Document open", 16, "Error"
        Exit Sub
    End If
   

   

    Dim oApp As Application
    Set oApp = ThisApplication

    If ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
   
        Dim i As Long
        Dim oDrawDoc As DrawingDocument
        Dim norm As String
        Set oDrawDoc = ThisApplication.ActiveDocument
       
       
     
        On Error Resume Next
        For i = oDrawDoc.TitleBlockDefinitions.Count To 1 Step -1
             
            oDrawDoc.TitleBlockDefinitions.Item(i).Delete
     
        Next i
       
        Dim oNewDocument As DrawingDocument
        Set oNewDocument = ThisApplication.ActiveDocument
       
        Dim oSourceDocument As DrawingDocument
        Set oSourceDocument = ThisApplication.Documents.Open(Environ$("Inventor") & "\norm.idw", False)
       
   
        ' Get the new source title block definition.
        Dim oSourceTitleBlockDef As TitleBlockDefinition
        Set oSourceTitleBlockDef = oSourceDocument.ActiveSheet.TitleBlock.Definition
   
        If Not oNewDocument.ActiveSheet.TitleBlock.Definition.Name = oSourceDocument.ActiveSheet.TitleBlock.Definition.Name Then
           
   
        ' Get the new title block definition.
        Dim oNewTitleBlockDef As TitleBlockDefinition
        Set oNewTitleBlockDef = oSourceTitleBlockDef.CopyTo(oNewDocument)
   
   
   
        ' Iterate through the sheets.
        Dim oSheet As Sheet
        For Each oSheet In oNewDocument.Sheets
            oSheet.Activate
            oSheet.TitleBlock.Delete
            Call oSheet.AddTitleBlock(oNewTitleBlockDef)
        Next
        oSourceDocument.Close SaveChanges = False
           
        Set oDrawDoc = ThisApplication.ActiveDocument
     
        On Error Resume Next
        For i = oDrawDoc.TitleBlockDefinitions.Count To 1 Step -1
             
            oDrawDoc.TitleBlockDefinitions.Item(i).Delete
     
        Next i
         
        For i = oDrawDoc.SketchedSymbolDefinitions.Count To 1 Step -1
     
            oDrawDoc.SketchedSymbolDefinitions.Item(i).Delete
     
        Next i
       
       
        On Error GoTo 0
   
        Set oDrawDoc = Nothing
   
        End If
    End If
   
    ThisApplication.ActiveDocument.Save

   
   
End Sub

---

Nun soll das Makro noch folgende 3 Schritte ausführen...
Stile aktualisieren, Stile löschen
und unter aktive Norm die Standardnorm auf "Standardnorm (Iso)"
stellen.

Leider habe ich keinen Plan wie ich das realisieren kann...

Meine Versuche mit "oDrawDoc.StylesManager.ActiveStandardStyle"
waren bis dahin erfolglos...
Das Makro hat mir leider nur einen neuen Stil eingefügt und diesen aktiv gesetzt, möchte aber einen vorhandenen aus der Bibliothek verwenden...

Hoffe es kann mir jemand helfen...

Thx!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP