| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
| |
| Auf dem Weg zur digitalen Auftragsmappe. (Phoenix/PDM,SOLIDWORKS,PDM System,PLM,PLM System), ein Anwenderbericht
|
Autor
|
Thema: VBA - Anpassung (2650 mal gelesen)
|
Bluejay Mitglied Ingenieur
Beiträge: 203 Registriert: 14.05.2007 Inventor 2008 for Simulation SP3 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 Inventor 2017.4.12 64 bit Windows 10 Enterprise 64 bit 3DEXPERIENCE R2016x -------------------- HP Z-Book 15 G4 32 Gig Ram NVIDIA Quadro M2200 2x HP E243i
|
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 2008 for Simulation SP3 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 2008 for Simulation SP3 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 Moderator Rentner
Beiträge: 13006 Registriert: 29.08.2003 Toshiba Encore mit MS Office Ein Programm sollte nicht nur Hand und Fuß, sondern auch Herz und Hirn haben. (Michael Anton)
|
erstellt am: 19. Dez. 2011 10:28 <-- editieren / zitieren --> Unities abgeben: Nur für Bluejay
|