my code


Replace Titleblock, update Styles, place revision table
by TimonF

Es wird der Schriftkopf mit dem einer neuen Vorlage ausgetauscht und dabei gleich alle Stile aktualisiert, anschließend wird die Vault Revisionstabelle eingefügt

Snippet options

Download: Download snippet as replace-titleblock-update-styles-place-revision-table.vbs.
Copy snippet: For this you need a free my code account.
Embed code : You will find the embed code for this snippet at the end of the page, if you want to embed it into a website or a blog!

Const TEMPLATE_FILENAME = "Norm.idw"
    On Error Resume Next
    Dim oApp As Application
    Set oApp = ThisApplication
    oApp.SilentOperation = True
    ' Exit if no document open
    If oApp.Documents.Count = 0 Then
        oApp.SilentOperation = False
        Exit Sub
    End If
    ' Exit if no drawing open
    If Not oApp.ActiveDocument.DocumentType = kDrawingDocumentObject Then
        oApp.SilentOperation = False
        Exit Sub
    End If
    ' Get active drawing
    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = oApp.ActiveDocument
    ' Open new drawing
    Dim oTempDoc As DrawingDocument
    Set oTempDoc = oApp.Documents.Add(kDrawingDocumentObject, oApp.DesignProjectManager.ActiveDesignProject.TemplatesPath & TEMPLATE_FILENAME, False)
    ' Exit if no template
    If oTempDoc Is Nothing Then
        Call MsgBox("Die Vorlage """ & TEMPLATE_FILENAME & """ konnte nicht geöffnet werden!", vbCritical + vbOKOnly, "CDN_UPDATEDRAWING")
        oApp.SilentOperation = False
        Exit Sub
    End If
    ' Copy title block definitions
    Dim oTitleDefinition As TitleBlockDefinition
    For Each oTitleDefinition In oTempDoc.TitleBlockDefinitions
        Call oTitleDefinition.CopyTo(oDrawDoc, True)
    ' Close new drawing
    oTempDoc.Close (True)
    oApp.SilentOperation = False
    ' Update Styles
    Dim oStyles As Styles
    Dim oStyle As Style
    Set oStyles = oDrawDoc.StylesManager.Styles
    For Each oStyle In oStyles
        If Not oStyle.UpToDate Then
        End If
    Dim customPropSet As PropertySet
    Set customPropSet = oDrawDoc.PropertySets.Item("Inventor User Defined Properties")
    Dim customProp As Inventor.Property
    Set customProp = customPropSet.Item("1AIMD_REVISION_INDEX")
    'If there is a Rev B, then place Rev Table
    If customProp.Value = "A" Then
        Dim oCommandMgr As CommandManager
        Set oCommandMgr = ThisApplication.CommandManager
            Dim oRTBs As RevisionTables
            Set oRTBs = oDrawDoc.ActiveSheet.RevisionTables
            Dim oRevTable As RevisionTable
            For Each oRevTable In oRTBs
            'User has to place the Vault Rev Table
    End If
End Sub

Create a free my code account now.

my code is a free service, which allows you to save and manage code snippes of any kind and programming language. We provide many advantages for your daily work with code-snippets, also for your teamwork. Give it a try!

Find out more and register now

You can customize the height of iFrame-Codes as needed! You can find more infos in our API Reference for iframe Embeds.