Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Inventor
  Schriftkopf via Knopfdruck austauschen?

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
Autor Thema:  Schriftkopf via Knopfdruck austauschen? (521 mal gelesen)
freierfall
Ehrenmitglied V.I.P. h.c.
selbstst. techn. Zeichner



Sehen Sie sich das Profil von freierfall an!   Senden Sie eine Private Message an freierfall  Schreiben Sie einen Gästebucheintrag für freierfall

Beiträge: 11167
Registriert: 30.04.2004

WIN10 64bit, 32GB RAM
IV bis 2022

erstellt am: 04. Nov. 2021 08:06    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Liebe Gemeinde, ich habe auf einem Rechner zwar durch das MUM-Tool dies schon auf einem anderen Rechner nicht 

Kann mir jemand helfen und so einen vba schreiben wo von einen definierten Pfad die der Schriftkopf aus der Norm.idw kopiert wird und in die gerade geöffnete Zeichnung paltziert wird.

herzlichen Dank Sascha

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

fons
Mitglied



Sehen Sie sich das Profil von fons an!   Senden Sie eine Private Message an fons  Schreiben Sie einen Gästebucheintrag für fons

Beiträge: 32
Registriert: 30.03.2009

Inventor 2019 @ Win10 64bit / Vault Basic 2019

erstellt am: 04. Nov. 2021 08:43    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für freierfall 10 Unities + Antwort hilfreich

Ich kann es dir nicht schreiben, aber diesen Codeschnipsel geben:

Code:
        'Zeichnung akt
        Sub zeichnungsResourcen_akt() ' aktualisieren (aus vorlage übernehmen)

            'ersetzt die Zeichnungsresourcen in der aktuellen Zeichnung durch die der Template

            Dim Blatt As Sheet
            Blatt = oDocD.ActiveSheet
            Dim i, j As Integer
            Dim zahl1 As Long
            Dim zahl2 As Long


            'vorhandenes Schriftfeld und Rahmen aus aktiver Zeichnung löschen (Step#2)
            'On Error Resume Next
            Dim osheet As Sheet
            For Each osheet In oDocD.Sheets
                osheet.Activate()
                osheet.TitleBlock.Delete()
                osheet.Border.Delete()
            Next

            zahl1 = oDocD.TitleBlockDefinitions.Count
            For i = 1 To zahl1
                On Error Resume Next
                oDocD.TitleBlockDefinitions.Item(zahl1 + 1 - i).Delete()
            Next


            'Resourcen der Template defenieren und Kopieren(Step#5)
            Dim oSketchedSymbolDef As SketchedSymbolDefinition
            Dim arbeitsordner As String
            arbeitsordner = oApp.DesignProjectManager.ActiveDesignProject.WorkspacePath

            Dim QuellDoc As DrawingDocument
            QuellDoc = oApp.Documents.Open(arbeitsordner & "\8 Vorlagen\Norm.idw")

            Dim QuellSchriftfeld As TitleBlockDefinition
            QuellSchriftfeld = QuellDoc.TitleBlockDefinitions.Item("DIN")
            Dim ZielSchriftfeld As TitleBlockDefinition
            ZielSchriftfeld = QuellSchriftfeld.CopyTo(oDocD, True)


            QuellDoc.Close()

            'fügt Zeichnungsrahmen ins Active Blatt ein (Step#7)
            'Call Blatt.AddBorder(ZielRahmen)
            For Each osheet In oDocD.Sheets
                osheet.Activate()
                osheet.AddDefaultBorder(,,,,,, Centermarks:=False, TopMargin:=0.7, BottomMargin:=0.7, LeftMargin:=1.3, RightMargin:=0.7)
            Next

            'fügt neues Schriftfeld in alle Blätter ein(Step#8)
            For Each osheet In oDocD.Sheets
                osheet.Activate()
                osheet.AddTitleBlock(oDocD.TitleBlockDefinitions.Item("DIN"))
            Next


            'schaltet Browserleiste wieder ein (Step#9)
            oApp.UserInterfaceManager.ShowBrowser = True
            'Else : MsgBox("Ein Schriftfeld kann nur in eine Zeichnung eingefügt werden!")
            'End If

        End Sub


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

rkauskh
Moderator
Dipl.-Ing. (FH) Versorgungstechnik


Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 1881
Registriert: 15.11.2006

Windows 10 x64, AIP 2021

erstellt am: 04. Nov. 2021 09:25    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für freierfall 10 Unities + Antwort hilfreich

Moin

@fons
Dein Script räumt aber alle vorhandenen Schriftköpfe und Rahmen aus der Zeichnung. Das sollte man vielleicht dazu sagen.
Lauffähig ist es so auch nicht, da z.B. die Deklaration von oApp und DocD fehlen.  

@freierfall
Da ich es eh fertig habe, als Alternativvorschlag. Ist iLogic Code.

Code:

Option Explicit on

Private Sub Main()
' tauscht Schriftfeld aus

Dim oSource As DrawingDocument
Dim oTrans As Transaction = ThisApplication.TransactionManager.StartTransaction(ThisDoc.Document, "Replace Titleblock")

Try
ThisApplication.ScreenUpdating = False

Dim sSource As String
sSource = "C:\Temp\Source.idw" ' <--- vollständiger Pfad zur Quelldatei
Dim sSourceTitleBlockname As String
sSourceTitleBlockname = "MyNewTitleblock" ' <--- Name der Schriftfelddefinition in der Quelldatei

If Not System.IO.File.Exists(sSource) Then
    Call MsgBox("Konnte Quelldatei '" & sSource & "' nicht finden.", vbCritical, "Replace Titleblock")
    Exit Sub
End If
   
oSource = ThisApplication.Documents.Open(sSource, False)

Dim oSourceTitleBlockDef As TitleBlockDefinition
For Each oSourceTitleBlockDef In oSource.TitleBlockDefinitions
    If oSourceTitleBlockDef.Name = sSourceTitleBlockname Then
        Exit For
    End If
Next

If oSourceTitleBlockDef Is Nothing Then
    MsgBox("Konnte Quellschriftfeld '" & sSourceTitleBlockname & "' nicht finden.", vbCritical, "Replace Titleblock")
    Exit Sub
End If

Dim oDrawDoc As DrawingDocument = ThisDoc.Document
Dim bAllSheets As Boolean=False
If oDrawDoc.Sheets.Count > 1 Then
If MsgBox("In allen Blättern austauschen?", MsgBoxStyle.YesNo, "iLogic Replace Titleblock")=MsgBoxResult.Yes Then bAllSheets=True
End If

Dim oTitleblockDef As TitleBlockDefinition
Dim oNewTitleblockDef As TitleBlockDefinition
For Each oTitleblockDef In oDrawDoc.TitleBlockDefinitions
If oTitleblockDef.Name = sSourceTitleBlockname Then
If MsgBox("Ein Schriftfeld mit gleichem Namen (" & oSourceTitleBlockDef.Name & " existiert bereits. Überschreiben?", MsgBoxStyle.YesNo, "iLogic Replace Titleblock") = MsgBoxResult.Yes Then
oNewTitleblockDef = oSourceTitleBlockDef.CopyTo(oDrawDoc, True)
Exit For
Else
oNewTitleblockDef = oSourceTitleBlockDef.CopyTo(oDrawDoc, False)
End If
End If
Next

If oNewTitleblockDef Is Nothing Then oNewTitleblockDef = oSourceTitleBlockDef.CopyTo(oDrawDoc)

Dim oSheet As Sheet
Dim oActiveSheet As Sheet=oDrawDoc.ActiveSheet
If bAllSheets=True Then
    For Each oSheet In oDrawDoc.Sheets
oSheet.Activate
        oSheet.TitleBlock.Delete
        oSheet.AddTitleBlock (oNewTitleblockDef)
    Next
oActiveSheet.Activate
Else
    If Not oActiveSheet.TitleBlock Is Nothing Then oDrawDoc.ActiveSheet.TitleBlock.Delete
    oActiveSheet.AddTitleBlock(oNewTitleblockDef)
End If

oSource.Close (True)

oTrans.End
Catch ex As Exception
oTrans.Abort
MsgBox(ex.Message,MsgBoxStyle.Critical,"iLogic Replace Titleblock" )
If Not oSource Is Nothing Then oSource.Close(True)
Finally
ThisApplication.ScreenUpdating=True
End Try

End Sub


------------------
MfG
Ralf

RKW Solutions GmbH
www.RKW-Solutions.com

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

freierfall
Ehrenmitglied V.I.P. h.c.
selbstst. techn. Zeichner



Sehen Sie sich das Profil von freierfall an!   Senden Sie eine Private Message an freierfall  Schreiben Sie einen Gästebucheintrag für freierfall

Beiträge: 11167
Registriert: 30.04.2004

WIN10 64bit, 32GB RAM
IV bis 2022

erstellt am: 04. Nov. 2021 10:43    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

wow, es geht super gut. für mich ist das echt nicht verständlich  deswegen bin ich Dir sehr dankbar. sei herzlich gegrüsst Sascha

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

thpg
Mitglied
Konstrukteur


Sehen Sie sich das Profil von thpg an!   Senden Sie eine Private Message an thpg  Schreiben Sie einen Gästebucheintrag für thpg

Beiträge: 80
Registriert: 15.11.2007

Inventor 2019
Vault Basic 2019
Win10 64bit
Dell Precision Tower7910
Intel Xeon E5-2650 v3 @ 2,3Ghz
64GB RAM
AMD FirePro W7100 (FireGL V)

erstellt am: 04. Nov. 2021 11:44    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für freierfall 10 Unities + Antwort hilfreich

Hallo,

genau sowas benötige ich auch!!
Unser Firmenstandart hat sich geändert und wir müssen fast
alle Schriftköpfe austauschen.
Genial das es sowas gibt.
Nun habe ich noch Fragen über Fragen dazu.
Tauscht das NUR den Schriftkopf aus?
Wo muss ich den Quellpfad ändern?
und wie bekomme ich das in eine Ilogic?

Sorry, aber ich kenn mich damit so gut wie gar nicht aus.

MfG Thomas

------------------
==========
MfG
Thomas

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

rkauskh
Moderator
Dipl.-Ing. (FH) Versorgungstechnik


Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 1881
Registriert: 15.11.2006

Windows 10 x64, AIP 2021

erstellt am: 04. Nov. 2021 12:09    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für freierfall 10 Unities + Antwort hilfreich

Hallo

@thpg
1. Ja, das tauscht nur den Schriftkopf aus, weil Sascha ja nur den Schriftkopf austauschenn wollte.
2. Den Quellpfad ändert man in einer der obersten Zeilen ( da wo der Kommentar : "vollständiger Pfad zur Quelldatei") steht. Knapp darunter kommt die Zeile in der man den Namen des Schriftfeldes in der Quelldatei eingibt.
3. Das ist iLogic Code. Einfach Copy'n Paste in eine neue externe Regel und ausführen.

@freierfall
Falls du mich gemeint hast, ich mach das ja auch seit 20 Jahren und mittlerweile hauptberuflich. 

------------------
MfG
Ralf

RKW Solutions GmbH
www.RKW-Solutions.com

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

thpg
Mitglied
Konstrukteur


Sehen Sie sich das Profil von thpg an!   Senden Sie eine Private Message an thpg  Schreiben Sie einen Gästebucheintrag für thpg

Beiträge: 80
Registriert: 15.11.2007

Inventor 2019
Vault Basic 2019
Win10 64bit
Dell Precision Tower7910
Intel Xeon E5-2650 v3 @ 2,3Ghz
64GB RAM
AMD FirePro W7100 (FireGL V)

erstellt am: 04. Nov. 2021 12:59    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für freierfall 10 Unities + Antwort hilfreich

Mahlzeit,

Danke, wer lesen kann ist klar von Vorteil.

Super!!
Es funktioniert!!

------------------
==========
MfG
Thomas

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

mb-ing
Mitglied
F&E-Mangement, MB-Ing. (u)


Sehen Sie sich das Profil von mb-ing an!   Senden Sie eine Private Message an mb-ing  Schreiben Sie einen Gästebucheintrag für mb-ing

Beiträge: 683
Registriert: 06.09.2012

Inventor 2021 WIN 10 (64bit), Dell Precision T1650, 16GB (Pro.File 8.7)

erstellt am: 05. Nov. 2021 07:15    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für freierfall 10 Unities + Antwort hilfreich

Nur zur Ergänzung:
Ich verwende bei meinen Schriftköpfen zusätzlich Attribute-Sets. Das hat den Charme, dass ich den verschiedenen Schriftköpfen in der Vorlage Schriftkopfversion, Schriftkopfart (intern, extern), Schriftkopfsprache (de, en) etc. zuweisen bzw. natürlich auch abfragen kann.
Sprich beim Ausführen meiner Funktion wird anhand der Attribute-Sets geprüft, welcher Schriftkopf aktuell vorhanden ist. Dann erfolgt eine Prüfung, ob es eine neuere Version in der Vorlage gibt. Erst wenn dies zutrifft, wird der Schriftkopf mit seinem adäquaten Nachfolger ausgetauscht.

Der Jobserver kennt die aktuellen Versionsstände und gibt nur Zeichnungen mit aktuellen Schriftkopf frei...

Auch für die VBA-Kollegen kann man mittels dem Attribute-Manager direkt mit dem Namen auf ein Attribute zugreifen und muss nicht alle mühsam durchlaufen.  

Generell sind Attribute-Sets eine klasse Sache  
https://modthemachine.typepad.com/my_weblog/2009/07/introduction-to-attributes.html

VG
MB-Ing.

------------------
Wissen ist Macht. Nichts wissen macht auch nichts  

[CS-Edit: Hab DIr mal den Link zurechtgeruckelt ;-) ]

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

thpg
Mitglied
Konstrukteur


Sehen Sie sich das Profil von thpg an!   Senden Sie eine Private Message an thpg  Schreiben Sie einen Gästebucheintrag für thpg

Beiträge: 80
Registriert: 15.11.2007

Inventor 2019
Vault Basic 2019
Win10 64bit
Dell Precision Tower7910
Intel Xeon E5-2650 v3 @ 2,3Ghz
64GB RAM
AMD FirePro W7100 (FireGL V)

erstellt am: 08. Nov. 2021 14:15    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für freierfall 10 Unities + Antwort hilfreich

Hallo,

ich habe leider noch eine Frage dazu.

Wir haben für bestimmte Bauteile einen speziellen Schriftkopf
mit einer angeforderten Eingabe in den iProberties, bei der dann Fertigungsparameter mit eingetragen werden.
Bei diesem Schriftkopf funktioniert die iLogic leider nicht.

Gibt es evtl. dafür auch eine Lösung?

Ich wäre sehr dankbar dafür.

------------------
==========
MfG
Thomas

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

rkauskh
Moderator
Dipl.-Ing. (FH) Versorgungstechnik


Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 1881
Registriert: 15.11.2006

Windows 10 x64, AIP 2021

erstellt am: 08. Nov. 2021 22:02    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für freierfall 10 Unities + Antwort hilfreich

Hallo

Für jede angeforderte Eingabe kommt jetzt eine Eingabeaufforderung. Ich hoffe ihr habt nicht 100 davon in eurem Schriftfeld. Bitte beachten, die Abfrage kommt pro angeforderter Eingabe nur einmal und verwendet die Eingaben für alle Blätter, wenn "Schriftfeld in allen Blätter austauschen" gewählt wurde. Sollten unterschiedliche Werte erforderlich sein, entweder die Schriftfelder einzeln ersetzen oder nach dem Ersetzen jedes Blatt nacharbeiten. Man könnte zwar für jedes Blatt die Angaben einzeln abfragen, aber ich denke mit 10 angeforderten Eingabe und 5 Blättern (= 50 angeforderte Eingaben) wird das sehr fehleranfällig.


Code:

Option Explicit on

Private Sub Main()
' tauscht Schriftfeld aus

Dim oSource As DrawingDocument
Dim oTrans As Transaction = ThisApplication.TransactionManager.StartTransaction(ThisDoc.Document, "Replace Titleblock")

Try
ThisApplication.ScreenUpdating = False

Dim sSource As String
sSource = "C:\Temp\Source.idw" ' <--- vollständiger Pfad zur Quelldatei
Dim sSourceTitleBlockname As String
sSourceTitleBlockname = "MyNewTitleblock" ' <--- Name der Schriftfelddefinition in der Quelldatei

If Not System.IO.File.Exists(sSource) Then
    Call MsgBox("Konnte Quelldatei '" & sSource & "' nicht finden.", vbCritical, "Replace Titleblock")
    Exit Sub
End If

Dim bOpen As Boolean=False
For Each oDoc As Document In ThisApplication.Documents
If oDoc.FullFileName.ToUpper  = sSource.ToUpper  Then
oSource = TryCast(oDoc,Inventor.DrawingDocument)
oDoc=Nothing
Exit For
End If
Next

If oSource Is Nothing Then
oSource = ThisApplication.Documents.Open(sSource, False)
bOpen = True
End If

Dim oSourceTitleBlockDef As TitleBlockDefinition
For Each oSourceTitleBlockDef In oSource.TitleBlockDefinitions
    If oSourceTitleBlockDef.Name  = sSourceTitleBlockname Then
        Exit For
    End If
Next

If oSourceTitleBlockDef Is Nothing Then
    MsgBox("Konnte Quellschriftfeld '" & sSourceTitleBlockname & "' nicht finden.", vbCritical, "Replace Titleblock")
    Exit Sub
End If

Dim oDrawDoc As DrawingDocument = ThisDoc.Document
Dim bAllSheets As Boolean=False
If oDrawDoc.Sheets.Count > 1 Then
If MsgBox("In allen Blättern austauschen?", MsgBoxStyle.YesNo, "iLogic Replace Titleblock")=MsgBoxResult.Yes Then bAllSheets=True
End If

Dim oTitleblockDef As TitleBlockDefinition
Dim oNewTitleblockDef As TitleBlockDefinition
For Each oTitleblockDef In oDrawDoc.TitleBlockDefinitions
If oTitleblockDef.Name = sSourceTitleBlockname Then
If MsgBox("Ein Schriftfeld mit gleichem Namen (" & oSourceTitleBlockDef.Name & " existiert bereits. Überschreiben?", MsgBoxStyle.YesNo, "iLogic Replace Titleblock") = MsgBoxResult.Yes Then
oNewTitleblockDef = oSourceTitleBlockDef.CopyTo(oDrawDoc, True)
Exit For
Else
oNewTitleblockDef = oSourceTitleBlockDef.CopyTo(oDrawDoc, False)
End If
End If
Next

If oNewTitleblockDef Is Nothing Then oNewTitleblockDef = oSourceTitleBlockDef.CopyTo(oDrawDoc)

Dim sString As String
Dim sPrompt As String
Dim oTextBox As Inventor.TextBox
For Each oTextBox In oNewTitleblockDef.Sketch.TextBoxes
If oTextBox.FormattedText.StartsWith("<Prompt") Then
sPrompt=InputBox("Angeforderte Eingabe für " & oTextBox.Text & ":","iLogic Replace Titleblock")
If sPrompt=String.Empty Then
sPrompt = " "
End If
If sString = String.Empty Then
sString=sPrompt
Else
sString=sString & vbLf & sPrompt
End If
End If
Next

Dim aStrings() As String = Split(sString,vbLf)

Dim oSheet As Sheet
Dim oActiveSheet As Sheet = oDrawDoc.ActiveSheet
Dim oTitleBlock As TitleBlock
If bAllSheets=True Then
    For Each oSheet In oDrawDoc.Sheets
oSheet.Activate
        If Not oSheet.TitleBlock Is Nothing Then oSheet.TitleBlock.Delete
If UBound(aStrings) >=0 Then
    oTitleBlock=oSheet.AddTitleBlock(oNewTitleblockDef, , aStrings)
Else
oTitleBlock=oSheet.AddTitleBlock(oNewTitleblockDef)
End If
    Next
oActiveSheet.Activate
Else
    If Not oActiveSheet.TitleBlock Is Nothing Then oDrawDoc.ActiveSheet.TitleBlock.Delete
If UBound(aStrings) >=0 Then
    oTitleBlock=oActiveSheet.AddTitleBlock(oNewTitleblockDef, ,aStrings)
Else
oTitleBlock=oActiveSheet.AddTitleBlock(oNewTitleblockDef)
End If
End If

If bOpen=True Then
oSource.Close(True)
Else
oSource=Nothing
End If

oTrans.End
Catch ex As Exception
oTrans.Abort
MsgBox(ex.Message,MsgBoxStyle.Critical,"iLogic Replace Titleblock" )
If Not oSource Is Nothing Then oSource.Close(True)
Finally
ThisApplication.ScreenUpdating=True
End Try

End Sub


------------------
MfG
Ralf

RKW Solutions GmbH
www.RKW-Solutions.com

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

thpg
Mitglied
Konstrukteur


Sehen Sie sich das Profil von thpg an!   Senden Sie eine Private Message an thpg  Schreiben Sie einen Gästebucheintrag für thpg

Beiträge: 80
Registriert: 15.11.2007

Inventor 2019
Vault Basic 2019
Win10 64bit
Dell Precision Tower7910
Intel Xeon E5-2650 v3 @ 2,3Ghz
64GB RAM
AMD FirePro W7100 (FireGL V)

erstellt am: 09. Nov. 2021 08:12    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für freierfall 10 Unities + Antwort hilfreich

Guten Morgen,

wir haben es gleich getestet,
es funktioniert alles!
Vielen herzlichen Dank!

------------------
==========
MfG
Thomas

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2021 CAD.de | Impressum | Datenschutz