| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
| |
| PNY wird von NVIDIA zum Händler des Jahres gewählt – zum dritten Mal in Folge, eine Pressemitteilung
|
Autor
|
Thema: VBA - Anpassung (2904 mal gelesen)
|
Bluejay Mitglied Ingenieur
Beiträge: 203 Registriert: 14.05.2007 Inventor 2011 for Simulation<P>Microsoft Windows XP Professional<P>Dell Precision T3400 Intel(R) Core(TM)2 Duo CPU E6750 @2,66 GHz 3,00 GB RAM
|
erstellt am: 13. Dez. 2011 11:07 <-- editieren / zitieren --> Unities abgeben:
Hallo zusammen, wer von euch kann mir mit einer kleinen VBA Anpassung helfen - bin blutiger VBA Anfänger und habe mir folgenden Code schon hier aus dem Forum besorgt und versucht an meine Bedürfnisse anzupassen. Der Code tauscht Symbole und Rahmen/Schriftfelder aus einer bestehenden Zeichnung mir der einer Vorlage aus - Mein Problem bis jetzt kopierte er alles auch gut aus der Vorlage in die bestehende Datei - überschreibt aber nicht die schon vorhandenen - er erstellt aus noch mal kopien der einzelnen elemente? Hier mal der code Sub Schriftfeld() ' ersetzt das Schriftfeld in der aktuellen Zeichnung durch ein neues (Position siehe **) 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 Rahmen löschen On Error Resume Next Blatt.Border.Delete j = ZielDoc.BorderDefinitions.Count For i = 1 To j ZielDoc.BorderDefinitions.Item(j + 1 - i).Delete Next 'löscht vorhandene skizzierte Symbole zahl1 = ZielDoc.SketchedSymbolDefinitions.Count For i = 1 To zahl1 On Error Resume Next ZielDoc.SketchedSymbolDefinitions.Item(zahl1 + 1 - i).Delete Next Dim oSketchedSymbolDef As SketchedSymbolDefinition Dim QuellDoc As DrawingDocument Set QuellDoc = ThisApplication.Documents.Open("\\gainserver\gain\GAIN\Iface\Inventor\Templates\R15\Norm.idw") '** Dim QuellRahmen As BorderDefinition Set QuellRahmen = QuellDoc.BorderDefinitions.Item("Rahmen") Dim ZielRahmen As BorderDefinition Set ZielRahmen = QuellRahmen.CopyTo(ZielDoc) Dim QuellSchriftfeld As TitleBlockDefinition Set QuellSchriftfeld = QuellDoc.ActiveSheet.TitleBlock.Definition Dim ZielSchriftfeld As TitleBlockDefinition Set ZielSchriftfeld = QuellSchriftfeld.CopyTo(ZielDoc) 'fügt neue skizzierte Symbole aus Vorlagedatei ein zahl1 = QuellDoc.SketchedSymbolDefinitions.Count For i = 1 To zahl1 Set oSketchedSymbolDef = QuellDoc.SketchedSymbolDefinitions.Item(i).CopyTo(ZielDoc, True) Next QuellDoc.Close 'fügt Zeichnungsrahmen ins Blatt ein Call Blatt.AddBorder(ZielRahmen) 'fügt neues Schriftfeld in Zeichnung ein Blatt.TitleBlock.Delete Call Blatt.AddTitleBlock(ZielSchriftfeld) 'schaltet Browserleiste wieder ein ThisApplication.UserInterfaceManager.ShowBrowser = True Else: MsgBox ("Ein Schriftfeld kann nur in eine Zeichnung eingefügt werden!") End If End Sub Würde mich über alle Hilfen sehr freuen Vielen Dank schon mal MFG ------------------ MFG BlueJay Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
muellc Ehrenmitglied V.I.P. h.c. ICT Specialist
Beiträge: 3501 Registriert: 30.11.2006
|
erstellt am: 13. Dez. 2011 11:53 <-- editieren / zitieren --> Unities abgeben: Nur für Bluejay
|
Bluejay Mitglied Ingenieur
Beiträge: 203 Registriert: 14.05.2007 Inventor 2011 for Simulation<P>Microsoft Windows XP Professional<P>Dell Precision T3400 Intel(R) Core(TM)2 Duo CPU E6750 @2,66 GHz 3,00 GB RAM
|
erstellt am: 13. Dez. 2011 14:44 <-- editieren / zitieren --> Unities abgeben:
|
Bluejay Mitglied Ingenieur
Beiträge: 203 Registriert: 14.05.2007 Inventor 2011 for Simulation<P>Microsoft Windows XP Professional<P>Dell Precision T3400 Intel(R) Core(TM)2 Duo CPU E6750 @2,66 GHz 3,00 GB RAM
|
erstellt am: 19. Dez. 2011 10:18 <-- editieren / zitieren --> Unities abgeben:
Guten Morgen zusammen, ich muss noch einmal meine alte Frage aufgreifen und hoffe das mir jemand mit meinem Problem helfen kann. Und zwar möchte ich gerne mit einem VBA die gesamten Zeichnungsresourcen von einer Vorlage in die Active Zeichnung kopieren. Das VBA funktioniert mit dem folgendeb Code auch schon ganz gut - aber es löscht nicht alle bestehenden Schriftfelder aus den Zeichnungsresourcen der activen Zeichung und kopiert nich alle neuen Schriftfelder aus der Template in die Zeichung bzw. dessen Zeichungsresourcen. Sub Schriftfeld() ' ersetzt das Schriftfeld in der aktuellen Zeichnung durch ein neues (Position siehe **) 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 'vorhandenen Rahmen löschen On Error Resume Next Blatt.Border.Delete j = ZielDoc.BorderDefinitions.Count For i = 1 To j ZielDoc.BorderDefinitions.Item(j + 1 - i).Delete Next 'vorhandenen Schriftfelder löschen On Error Resume Next Title.Block.Delete j = ZielDoc.TitleBlockDefinition.Count For i = 1 To j ZielDoc.TitleBlockDefinition.Item(j + 1 - i).Delete Next 'vorhandene skizzierte Symbole löschen zahl1 = ZielDoc.SketchedSymbolDefinitions.Count For i = 1 To zahl1 On Error Resume Next ZielDoc.SketchedSymbolDefinitions.Item(zahl1 + 1 - i).Delete Next Dim oSketchedSymbolDef As SketchedSymbolDefinition Dim QuellDoc As DrawingDocument Set QuellDoc = ThisApplication.Documents.Open("\\gainserver\gain\GAIN\Iface\Inventor\Templates\R15\Norm.idw") '** Dim QuellRahmen As BorderDefinition Set QuellRahmen = QuellDoc.BorderDefinitions.Item("ESM Rahmen") Dim ZielRahmen As BorderDefinition Set ZielRahmen = QuellRahmen.CopyTo(ZielDoc, True) Dim QuellSchriftfeld As TitleBlockDefinition Set QuellSchriftfeld = QuellDoc.ActiveSheet.TitleBlock.Definition Dim ZielSchriftfeld As TitleBlockDefinition Set ZielSchriftfeld = QuellSchriftfeld.CopyTo(ZielDoc, True) 'fügt neue skizzierte Symbole aus Vorlagedatei ein zahl1 = QuellDoc.SketchedSymbolDefinitions.Count For i = 1 To zahl1 Set oSketchedSymbolDef = QuellDoc.SketchedSymbolDefinitions.Item(i).CopyTo(ZielDoc) Next QuellDoc.Close 'fügt Zeichnungsrahmen ins Blatt ein Call Blatt.AddBorder(ZielRahmen) 'fügt neues Schriftfeld in Zeichnung ein Blatt.TitleBlock.Delete Call Blatt.AddTitleBlock(ZielSchriftfeld) 'schaltet Browserleiste wieder ein ThisApplication.UserInterfaceManager.ShowBrowser = True Else: MsgBox ("Ein Schriftfeld kann nur in eine Zeichnung eingefügt werden!") End If End Sub Kann mir jemand mit dieser Aufgabe helfen? Vielen Dank
MFG ------------------ MFG BlueJay Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Michael Puschner Ehrenmitglied V.I.P. h.c. Rentner
Beiträge: 13006 Registriert: 29.08.2003
|
erstellt am: 19. Dez. 2011 10:28 <-- editieren / zitieren --> Unities abgeben: Nur für Bluejay
Zitat: Original erstellt von Bluejay: ... Kann mir jemand mit dieser Aufgabe helfen? ...
Die beste Hilfe hierzu erhält man sicherlich im richtigen Forum. Für Diskussionen über IV-VBA gibt es ein eigenes Forum: Inventor VBA Dorthin werde ich diesen Thread jetzt auch verschieben ... ------------------ Michael Puschner Autodesk Inventor Certified Expert Mensch und Maschine Scholle GmbH [Diese Nachricht wurde von Michael Puschner am 19. Dez. 2011 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
rkauskh Moderator Dipl.-Ing. (FH) Versorgungstechnik
Beiträge: 2580 Registriert: 15.11.2006 Windows 10 x64, AIP 2020-2025
|
erstellt am: 19. Dez. 2011 19:01 <-- editieren / zitieren --> Unities abgeben: Nur für Bluejay
Hallo Laß mich raten, deine Zeichnung hat mehr als ein Blatt?!?! Zeichnungsressourcen (Ränder und Schriftfelder lassen sich nur löschen, wenn sie auf keinem Blatt mehr eingefügt sind. Dein Script löscht aber nur auf dem aktuell aktiven Blatt. Das muß scheitern. Mein Glaskugel hält das jedenfalls für die wahrscheinlichste Ursache. Wenn du nur das Schriftfeld des aktiven Blattes aus der Quellzeichnung in die Zielzeichnung kopierst ist es kein Wunder das nicht alle Schriftfelder kopiert werden. Hellsehen kann der Inventor nicht. Ansonsten kann es helfen die On Error Resume Next - Zeilen mal auszukommentieren und die Fehler zu provozieren. Dann kriegt man mal'ne Fehlermeldung. Nächster Schritt wäre ein schrittweises durchlaufen des Scriptes mit F8 im VBA-Editor und schauen an welcher Stelle es genau kracht. ------------------ MfG RK Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Schattenbacke Mitglied Dipl.-Ing (FH)
Beiträge: 114 Registriert: 28.01.2009 Dell Precision T3500 Productstream Professional Easy 2011 Autodesk Inventor 2016
|
erstellt am: 12. Aug. 2013 15:38 <-- editieren / zitieren --> Unities abgeben: Nur für Bluejay
ACHTUNG! Sie antworten auf einen Beitrag der älter als 1 Jahr ist! Moin,
gibt es hierfür eine Erweiterung, dass er unsere derzeitigen Symbole und Ränder ersetzt. Er löscht im Moment einfach nur die Ränder raus, ersetzt sie aber nicht. Wahrscheinlich muss ich dort ja "ESM Rahmen" durch unsere Namen ersetzen, nur wir haben ja für jede Rahmengröße einen eigenen Namen und die Frage ist auch ob er unsere derzeitigen Rahmen mit dem gleichen Namen dann einfach ersetzen kann, genauso wie er es mit dem Schriftfeld tut. Bei den Symbolen soll praktisch das gleiche passieren. Gruß Marcus Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Bluejay Mitglied Ingenieur
Beiträge: 203 Registriert: 14.05.2007 Inventor 2011 for Simulation<P>Microsoft Windows XP Professional<P>Dell Precision T3400 Intel(R) Core(TM)2 Duo CPU E6750 @2,66 GHz 3,00 GB RAM
|
erstellt am: 09. Sep. 2013 13:53 <-- editieren / zitieren --> Unities abgeben:
|