Inventor: auf Knopfdruck Schriftkopf tauschen

Ich habe in meinem letzten Projekt ein kleines VBA Tool geschrieben welches dafür verwendet werden kann, aus einer angegeben Vorlage (Pfad) den Schriftkopf in die aktuelle Zeichnung zu kopieren. Smiley mit geöffnetem MundBenutzung auf eigene Gefahr Smiley   Sub Schriftkopf_tauschen()
   
   
    Dim odrawdoc As DrawingDocument
   
    On Error Resume Next
    Set odrawdoc = ThisApplication.ActiveDocument     If (odrawdoc.DocumentType <> kDrawingDocumentObject) Then Exit Sub
   
    Dim oTemplate As DrawingDocument
    Dim oSourceTitleBlockDef As TitleBlockDefinition
    Dim oNewTitleBlockDef As TitleBlockDefinition
    Dim oSheet As Sheet
    Dim titlename As String
   
    Dim Titelblock As TitleBlock
   
    Set oSheet = odrawdoc.ActiveSheet
   
    Set Titelblock = odrawdoc.ActiveSheet.TitleBlock
   
        If (Titelblock Is Nothing) Then
            MsgBox ("Kein Schriftkopf vorhanden")
            Exit Sub
               
        ElseIf (Titelblock.Name = "DIN") Then
            titlename = "DIN"
         
        Else:
            MsgBox ("Kein DIN Schriftkopf vorhanden")
            Exit Sub
        End If
   
    Set oTemplate = ThisApplication.Documents.Open("C:PROTOTYPENNorm.idw", False)
    Set oSourceTitleBlockDef = oTemplate.ActiveSheet.TitleBlock.Definition
    Set oNewTitleBlockDef = oSourceTitleBlockDef.CopyTo(odrawdoc, True)
   
    ‚ Iterate through the sheets.
    For Each oSheet In odrawdoc.Sheets
        ‚oSheet.Activate if error occurs
        oSheet.TitleBlock.Delete
        Call oSheet.AddTitleBlock(oNewTitleBlockDef)
    Next
    oTemplate.Close
   
    Exit Sub End Sub     Zwei Zeilen müssen auf die aktuelle Umgebung angebpasst werden: 1) Pfad an der die Prototypen Datei vorhanden ist Set oTemplate = ThisApplication.Documents.Open("C:TempPROTOTYPENnorm.idw", False)
  2) Name des Schriftkopfes ElseIf (Titelblock.Name = "DIN") Then
            titlename = "DIN"

Related Posts

  ' exit rule if no part or assembly is in the drawing yet If (ThisDrawing.Mo

Neues in Autodesk Inventor 2015 - Whats new in Inventor 2015 Um eine überragende Modellierung zu g

Update 3 für Inventor 2015 Service Pack 1 steht zum Download bereit: Inv2015_Update3_SP1_x32 Inv2

Nach dem Service Pack 2 braucht man nur mehr das Update 3 installieren. Dies beinhaltet ebenfalls d

  Hier eine Übersicht, welche Dateiformate Inventor 2016 importieren / exportieren kann &#

LEAVE YOUR COMMENTS