Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  SolidWorks
  Zeichnungsrahmen 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: SOLIDWORKS - DFMXpress
Autor Thema:   Zeichnungsrahmen austauschen (617 mal gelesen)
Nobody1976
Mitglied



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

Beiträge: 35
Registriert: 20.05.2014

SWX 2019 SP5.0

erstellt am: 29. Apr. 2019 15:27    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

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


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

Beiträge: 662
Registriert: 17.01.2007

SWX 2017 SP5
AutoCAD 2016
Win 10 pro 64 bit
Intel Xeon 3,6GHz
64GB RAM
Nvidia Quadro M5000
SWx EPDM

erstellt am: 29. Apr. 2019 15:51    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 Nobody1976 10 Unities + Antwort hilfreich

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



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

Beiträge: 35
Registriert: 20.05.2014

SWX 2019 SP5.0

erstellt am: 29. Apr. 2019 16: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

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


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

Beiträge: 662
Registriert: 17.01.2007

SWX 2017 SP5
AutoCAD 2016
Win 10 pro 64 bit
Intel Xeon 3,6GHz
64GB RAM
Nvidia Quadro M5000
SWx EPDM

erstellt am: 30. Apr. 2019 09:16    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 Nobody1976 10 Unities + Antwort hilfreich

Des einen Part ist des nächsten DrawingDoc... 

Gruß, Jens

------------------
CSWE =)

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

Nobody1976
Mitglied



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

Beiträge: 35
Registriert: 20.05.2014

SWX 2019 SP5.0

erstellt am: 30. Apr. 2019 09:22    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

Morgen Jens
War nur Blind.
Läuft mittlerweile top.
Danke für die Tipps.
Gruß Udo

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)2020 CAD.de | Impressum | Datenschutz