|
SolidWorks MakroMania ist eine Beispielsammlung einiger Makros, die Ihnen eine Vorstellung davon geben soll, was man auch schon mit Makros in SolidWorks alles anstellen kann. Der Code des Makros sollte so gut dokumentiert sein, dass Sie damit ohne weitere Anleitung verstehen, was gemacht wird. |
< voriges |
MakroMania Übersicht |
Nummer 26 Ansichten in Hohe Qualität |
|
Ich übernehme keine Haftung für die korrekte Funktion der Routinen oder irgendwelcher Schäden bei der Anwendung dieser Beispiele. Das gesamte Risiko trägt der Benutzer selbst. - Sorry, muss sein.
' **********************************************************************
' * Macro iterates through all views of all sheets of active drawing
' * and set the display mode to "high quality". This is espacially
' * useful for exporting, since there is no option in the "Save as"
' * dialog to autoconvert to high-quality prior to saving.
' * It is also useful for SW2003 FastHLR views (which is the same as
' * SW2004 draft mode views)
' *
' * Makro durchläuft alle Ansichten auf allen Blättern der aktiven
' * Zeichnung und stellt die Anzeigeart auf "Hohe Qualität". Dies ist
' * insbesondere vor dem Exportieren sinnvoll, da es keine Option dafür
' * in den Exportfunktionen gibt.
' * Auch kann das Makro für SolidWorks 2003 genutzt werden, wo es auch
' * Entwurfsqualitätsansichten gibt, dort heißt es FastHLR.
' *
' * 12.09.2003 Stefan Berlitz
' * http://solidworks.cad.de
' * http://swtools.cad.de
' *
' **********************************************************************
Dim swApp As Object
Dim RevNumber As String
Dim RevMajor, RevMinor As Integer
Dim DrawingDoc As Object
Dim ActiveSheet As Object
Dim ActiveSheetName As String
Dim Names As Variant
Dim SheetCount As Long
Dim View As Object
Dim ViewName As String
Dim ViewCount As Long
Dim displayMode As Integer
Dim displayEdgesInShadedMode As Boolean
Dim displayUseParentDisplayMode As Boolean
Dim i As Long ' loop counter
Dim msgtext(2) As String ' some texts for multi-language support
Const swDocNONE = 0 ' Used to be TYPE_NONE
Const swDocPart = 1 ' Used to be TYPE_PART
Const swDocASSEMBLY = 2 ' Used to be TYPE_ASSEMBLY
Const swDocDRAWING = 3 ' Used to be TYPE_DRAWING
Const swDocSDM = 4 ' Solid data manager.
Sub main()
' get the SolidWorks Object
' an SolidWorks anklinken
Set swApp = CreateObject("SldWorks.Application")
' choose active language
' und die Spracheinstellung überprüfen
CheckLanguage
' get active document, should be a drawing
' das aktive Dokument holen, sollte eine Drawing sein
Set DrawingDoc = swApp.ActiveDoc
' if no active document, exit; it is userfriendly to
' pop up an error message ;-)
' kein Dokumewnt -> User benachrichtigen
If DrawingDoc Is Nothing Then
MsgBox msgtext(0)
Exit Sub
End If
' check if a drawing is active
' dito wenn es keine Zeichnung ist
If (DrawingDoc.GetType <> swDocDRAWING) Then
MsgBox msgtext(1)
Exit Sub
End If
' check version of SolidWorks
' die SolidWorks Version checken und bei früheren Versionen als 2003 aussteigen
RevNumber = swApp.RevisionNumber
RevMajor = Val(Left(RevNumber, InStr(1, RevNumber, ".") - 1))
RevMinor = Val(Mid(RevNumber, InStr(1, RevNumber, ".") + 1, Len(RevNumber)))
If RevMajor < 11 Then
' only 2003 and above has facetted views
' nur 2003 und höher haben facettierte Ansichten
MsgBox msgtext(2)
End
End If
'
' Now iterate through sheets. We should remember which sheet was
' active so we can avtivate it after the process
' Jetzt durch alle Blätter laufen. Wir merken und das gerade aktive
' Blatt um anschließend dahin zurück zu kehren
Set ActiveSheet = DrawingDoc.GetCurrentSheet
ActiveSheetName = ActiveSheet.GetName
' get the sheet count and loop over all sheets
' dann die Anzahl der Blätter holen und alle nacheinander anspringen
SheetCount = DrawingDoc.GetSheetCount
Names = DrawingDoc.GetSheetNames
For i = 0 To SheetCount - 1
' activate sheet
' nächstes Blatt aktivieren
DrawingDoc.ActivateSheet Names(i)
' now iterate over the drawing views; the first view is
' always the sheet itself and there is never a model in
' it, but it's easier to check every view the same way
' alle Ansichten nacheiander durchlaufen; die erste View ist immer
' das Blatt selbst und enthält kein Modell, aber der Einfachheit
' halber machen wir für alle Ansichten das Gleiche
Set View = DrawingDoc.GetFirstView
' as long as there is a valid view
' solange es noch eine Ansicht gibt
While Not View Is Nothing
' check whether view is displayed facetted (= draft quality)
' überprüfen, ob der View überhaupt facettiert (= Entwurfsmodus) ist
'
If View.GetFacettedHlrDisplay = True Then
' get the current display mode (wireframe, HLG or HLR)
' dann den aktuelle Anzeigeart holen
displayMode = View.GetDisplayMode
' and whether the edges should be displayed if view is shaded
' und überprüfen, ob die Kanten bei schattierter Ansicht dargestellt werden
displayEdgesInShadedMode = View.GetDisplayEdgesInShadedMode
'
' set the view to non-facetted
' die Ansicht auf hohe Qualität setzen
'
' we have to check whether we are using SW2003 or SW2004 and above
' to maintain the "Use parent display mode" introduced in SW2004
' dabei zwischen 2003 und 2004 oder höher unterscheiden,um die
' Einstellung " Anzeige wie Elternansicht" beibehalten zu können
If RevMajor = 11 Then
' SolidWorks 2003
View.SetDisplayMode2 displayMode, False, displayEdgesInShadedMode
ElseIf RevMajor >= 12 Then
displayUseParentDisplayMode = View.GetUseParentDisplayMode
' SetDisplayMode3 works for SW2004 and above
View.SetDisplayMode3 displayUseParentDisplayMode, displayMode, False, displayEdgesInShadedMode
End If
End If
' ... and go for the next view
' ... und die nächste Ansicht
Set View = View.GetNextView
Wend
Next i
' reactivate sheet which was active
' dann das vorher aktuelle Blatt reaktivieren
DrawingDoc.ActivateSheet ActiveSheetName
End Sub
Private Sub CheckLanguage()
' check which language to apply. To make another language
' copy one of Subs called XyzString and make your changes
'
' Hier ausgucken welche Sprache benutzt wird. Um weitere
' Sprachen zu unterstützen unten einer der Subs kopieren
' Anpassungen machen und aufrufen
' Set swApp = CreateObject("SldWorks.Application") ' set by Sub main()
Select Case swApp.GetCurrentLanguage
Case "german"
msgtext(0) = "Kein Dokument offen, was sollte ich denn wohl tun?"
msgtext(1) = "Nur sinnvoll bei Zeichnungen"
msgtext(2) = "Nur bei SolidWorks 2003 und höher gibt es Entwurfsqualitätsansichten"
' Case "english"
' english is default, so change there
' Case "spanish"
' Case "french"
' Case "italian"
' Case "japanese"
Case Else
' english is default
msgtext(0) = "Nothing opened, so what should I look at?"
msgtext(1) = "Only useful with drawing"
msgtext(2) = "Only SolidWorks 2003 and above use facetted views"
End Select
End Sub
| Kritik und Anregungen bitte an Stefan Berlitz. Letzte Änderung dieser Seite am Donnerstag, 01. Februar 2007 17:40 |