| | | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für SOLIDWORKS | | | | Moderne CAx Entwicklungsmethoden: Generatives Design, Gitternetzstrukturen & MBD, ein Webinar am 11.10.2024
|
Autor
|
Thema: Zeichnungsrahmen austauschen (1207 / mal gelesen)
|
Nobody1976 Mitglied
Beiträge: 46 Registriert: 20.05.2014 SWX 2022 SP5.0
|
erstellt am: 29. Apr. 2019 15:27 <-- editieren / zitieren --> Unities abgeben:
Hallo ich habe mir mit Hilfe des Forum ein Makro geschrieben um den Zeichnungsrahmen auszutauschen. Leider wird bei dieser Methode die Beschriftung verschoben. Ich denke das liegt an der Massstabskorrektur da der Rahmenwechsel im Massstab 1:1 erfolgt. Kennt jemand eine bessere Methode so dass ich keine Beschriftungsprobleme bekomme? Anbei der benutzte Code. LG Udo Code: Private Sub Rahmen_austauschen()Dim Name As String Dim templateName As String Dim Breite_neu As Double Dim Hoehe_neu As Double Dim Blattmasstab_vorn As Single Dim Blattmasstab_hinten As Single Dim boolstatus As Boolean Set swApp = Application.SldWorks Set DrawingDoc = swApp.ActiveDoc Set Sheet = DrawingDoc.GetCurrentSheet Set LayerMgr = DrawingDoc.GetLayerManager Set Part = swApp.ActiveDoc If (DrawingDoc.GetType <> swDocDRAWING) Then ' wenn keine Zeichnung aktiv wird das Makro wieder beendet MsgBox "Nur für Zeichnungen geeignet.", vbOKOnly + vbInformation, "Keine Zeichnung" Exit Sub End If vSheetProps = Sheet.GetProperties Breite = vSheetProps(5) * 1000 Hoehe = vSheetProps(6) * 100 Blattmasstab_vorn = vSheetProps(2) Blattmasstab_hinten = vSheetProps(3) Name = Sheet.GetName Select Case Breite Case "210" Breite_neu = "210" Hoehe_neu = "297" templateName = "K:\Bibliotheken\Bibilothek SolidWorks\Blattformate\A4-hoch_ECTR.slddrt" Case "420" Breite_neu = "420" Hoehe_neu = "297" templateName = "K:\Bibliotheken\Bibilothek SolidWorks\Blattformate\A3-quer_ECTR.slddrt" Case "594" Breite_neu = "594" Hoehe_neu = "420" templateName = "K:\Bibliotheken\Bibilothek SolidWorks\Blattformate\A2-quer_ECTR.slddrt" Case "841" Breite_neu = "841" Hoehe_neu = "594" templateName = "K:\Bibliotheken\Bibilothek SolidWorks\Blattformate\A1-quer_ECTR.slddrt" Case "1189" Breite_neu = "1189" Hoehe_neu = "841" templateName = "K:\Bibliotheken\Bibilothek SolidWorks\Blattformate\A0-quer_ECTR.slddrt" End Select retval = DrawingDoc.SetupSheet4(Name, swDwgPapersUserDefined, swDwgTemplateCustom, "1", "1", False, templateName, Breite_neu, Hoehe_neu, "Standard") Set Sheet = DrawingDoc.GetCurrentSheet vSheetProps = Sheet.GetProperties Breite = vSheetProps(5) * 1000 Hoehe = vSheetProps(6) * 1000 boolstatus = Sheet.SetScale(Blattmasstab_vorn, Blattmasstab_hinten, True, False) End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CAD-Maler Mitglied Konstrukteur / CAD-Admin / Mädchen für alles
Beiträge: 727 Registriert: 17.01.2007 SWX 2023 SP5 Draftsight 2023 Win 11 Enterprise Intel i7-13700 2.10 GHz 64GB RAM Nvidia RTX A2000 12GB SWx EPDM AP+ CSWE 2018
|
erstellt am: 29. Apr. 2019 15:51 <-- editieren / zitieren --> Unities abgeben: Nur für Nobody1976
Lass doch das skalieren weg... Statt Code: retval = DrawingDoc.SetupSheet4(Name, swDwgPapersUserDefined, swDwgTemplateCustom, "1", "1", False, templateName, Breite_neu, Hoehe_neu, "Standard")
einfach Code: retval = DrawingDoc.SetupSheet4(Name, swDwgPapersUserDefined, swDwgTemplateCustom, Blattmasstab_vorn, Blattmasstab_hinten, False, templateName, Breite_neu, Hoehe_neu, "Standard")
sollte eigentlich ausreichen. Das SetScale dann weglassen. Das Makro, das wir hier verwenden, sieht ansonsten fast identisch aus: Code: Blattnamen = Part.GetSheetNames For Each Blattname In Blattnamen Part.ActivateSheet (Blattname) Set swSheet = Part.GetCurrentSheet() boolstatus = Part.ForceRebuild3(False) SheetProperties = swSheet.GetProperties papersize = SheetProperties(0) scale1 = SheetProperties(2) scale2 = SheetProperties(3) firstAngle = CBool(SheetProperties(4)) templateName = "" 'no sheetformat = no path Width = SheetProperties(5) Height = SheetProperties(6) propViewName = swSheet.CustomPropertyView Part.SetupSheet5 Blattname, swDwgPapersUserDefined, swDwgTemplateNone, scale1, scale2, firstAngle, "", Width, Height, propViewName, True 'Leeres Blatt setzen boolstatus = Part.ForceRebuild3(False) templatePfad = "D:\...\Vorlagen 2017\" If Width = "1,189" Then papersize = swDwgPaperA0size templateName = templatePfad & "a0....slddrt" ElseIf Width = "0,841" Then papersize = swDwgPaperA1size templateName = templatePfad & "a1....slddrt" ElseIf Width = "0,594" Then papersize = swDwgPaperA2size templateName = templatePfad & "a2....slddrt" ElseIf Width = "0,42" Then papersize = swDwgPaperA3size templateName = templatePfad & "a3....slddrt" Else papersize = swDwgPaperA4size templateName = templatePfad & "a4....slddrt" End If Part.SetupSheet5 Blattname, swDwgPapersUserDefined, swDwgTemplateCustom, scale1, scale2, firstAngle, templateName, Width, Height, propViewName, True ' Reload the sheet format from the specified location Part.ViewZoomtofit2 Part.ForceRebuild3 False Next Blattname
Gruß, Jens PS: Dir fehlt bei der ersten Höhe eine Null... ------------------ CSWE =) Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Nobody1976 Mitglied
Beiträge: 46 Registriert: 20.05.2014 SWX 2022 SP5.0
|
erstellt am: 29. Apr. 2019 16:43 <-- editieren / zitieren --> Unities abgeben:
Hallo Jens, vielen Dank für deine Antwort. Das mit dem Masstab hat wunderbar geklappt. Ich vermute ich brauch auch noch die andere Methode Part.SetupSheet5. Bei mir werden momentan die Ansichten auf Amerikanisch umgestellt. Leider weis ich nicht wie dein Part definiert ist. Kannst du mir die Definition noch zukommen lassen? Danke Gruß Udo Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CAD-Maler Mitglied Konstrukteur / CAD-Admin / Mädchen für alles
Beiträge: 727 Registriert: 17.01.2007 SWX 2023 SP5 Draftsight 2023 Win 11 Enterprise Intel i7-13700 2.10 GHz 64GB RAM Nvidia RTX A2000 12GB SWx EPDM AP+ CSWE 2018
|
erstellt am: 30. Apr. 2019 09:16 <-- editieren / zitieren --> Unities abgeben: Nur für Nobody1976
|
Nobody1976 Mitglied
Beiträge: 46 Registriert: 20.05.2014 SWX 2022 SP5.0
|
erstellt am: 30. Apr. 2019 09:22 <-- editieren / zitieren --> Unities abgeben:
|
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|