|
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 30 Konfigurationen einzeln speichern |
|
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.
Das Makro speichert jede Konfiguration des aktuellen Modells als eigenes SolidWorksdokument und löscht dabei alle anderen Konfigurationen. Als neue Dokumentname wird die Kombination aus originalem Dokument- und Konfigurationsnamen benutzt.
' **********************************************************************
' * Makro speichert alle Konfigurationen des aktuellen Modells in
' * einzelne SolidWorks-Dokumente ab. Für das Speichern der
' * Konfiguratonen in Neutralformaten benutzen Sie am einfachsten das
' * Makro ExportConfigAs von Thomas Weith aka Gismo
' * (Makro Nr. 16 auf http://solidworks.cad.de/mm_boerse02.htm)
' *
' * 16.09.2004 Stefan Berlitz (stefan.berlitz@solidworks.cad.de)
' * http://solidworks.cad.de
' * http://swtools.cad.de
' **********************************************************************
' this Constants are editable to customize behaviour
' separartor for new filename
Const mySeparator = "_-_"
' **********************************************************************
' do not edit below this line unless you know what you are doing ;-))
Const swDocNONE = 0
Const swDocPART = 1
Const swDocASSEMBLY = 2
Const swDocDRAWING = 3
Const swSaveAsOptions_Silent = 1
Const swSaveAsOptions_Copy = 2
Const swSaveAsOptions_SaveReferenced = 4
Const swSaveAsOptions_AvoidRebuildOnSave = 8
Const swSaveAsOptions_UpdateInactiveViews = 16
Const swSaveAsOptions_OverrideSaveEmodel = 32
Const swSaveAsOptions_SaveEmodelData = 64
Const swSaveAsOptions_DetachedDrawing = 128
Const swOpenDocOptions_Silent = 1
Const swOpenDocOptions_ReadOnly = 2
Const swOpenDocOptions_ViewOnly = 4
Const swOpenDocOptions_RapidDraft = 8
Const swOpenDocOptions_LoadModel = 16
Const swOpenDocOptions_AutoMissingConfig = 32
Const swSaveAsCurrentVersion = 0
Sub main()
Dim swApp As Object
Dim ModelDoc As Object
Dim ModelDocType As Long
Dim ModelPathName As String
Dim ModelPathExtension As String
Dim ModelTitle As String
Dim ModelSaveName As String
Dim Configuration As Object
Dim ConfigCount As Long
Dim ConfigNames As Variant
Dim MassProp As Variant
Dim openconfig As String
Dim errors As Long
Dim warnings As Long
Dim i As Long
Dim idel As Long
' an SolidWorks anklinken und aktives Assembly holen
Set swApp = CreateObject("SldWorks.Application")
Set ModelDoc = swApp.ActiveDoc
If ModelDoc Is Nothing Then
' dann war gar kein Dokument geöffnet, wie soll da was funktionieren
MsgBox "Kein Dokument aktiv"
Exit Sub
End If
If (ModelDoc.GetType = swDocDRAWING) Then
' wenn keine Modell aktiv ist wird das Makro wieder beendet
MsgBox "Nur für Modelle geeignet"
Exit Sub
End If
' Pfad und Titel zu diesem Modell merken
ModelPathName = ModelDoc.GetPathName
ModelTitle = ModelDoc.GetTitle
' checken, ob Modell nicht noch gespeichert werden muss
If ModelDoc.GetSaveFlag Then
If MsgBox("Modell vor der Bearbeitung speichern?", vbYesNo) = vbYes Then
ModelDoc.Save
End If
End If
ModelPathExtension = GetExtensionOnly(ModelPathName)
If UCase(ModelPathExtension) = ".SLDPRT" Then
ModelDocType = swDocPART
Else
ModelDocType = swDocASSEMBLY
End If
' dann erst mal das Modell zumachen, sonst nehmen wir u.U eine geänderte,
' aber nicht gespeicherte Konfiguration als Ausgangsbasis
swApp.CloseDoc ModelTitle
' erster Durchlauf: einmal öffnen und die vorhandenen
' Konfigurationen auslesen
Set ModelDoc = swApp.OpenDoc6(ModelPathName, ModelDocType, 0, openconfig, errors, warnings)
' dann alle Konfigurationen auslesen
ConfigCount = ModelDoc.GetConfigurationCount
ConfigNames = ModelDoc.GetConfigurationNames
' und Model wieder schließen
ModelTitle = ModelDoc.GetTitle
swApp.CloseDoc ModelTitle
' dann für alle Konfigurationen
For i = 0 To ConfigCount - 1
' das ursprüngliche Modell wieder laden, direkt mit der passenden Konfiguration
openconfig = ConfigNames(i)
Set ModelDoc = swApp.OpenDoc6(ModelPathName, ModelDocType, 0, openconfig, errors, warnings)
' ' workaround for OpenDoc6 config load sometimes failed????
' Call ModelDoc.ShowConfiguration2(openconfig)
' alle anderen Konfigurationen rausschmeissen
For idel = 0 To ConfigCount - 1
If i <> idel Then
' Konfiguration löschen
If Not ModelDoc.DeleteConfiguration2(ConfigNames(idel)) Then
If MsgBox("Konnte Konfiguration " & ConfigNames(idel) &
_
" nicht löschen. Abbrechen?", vbYesNo) = vbYes Then
End
End If
End If
End If
Next idel
' Namen zusammensetzen
ModelSaveName = GetFullPathNoExtension(ModelPathName) & mySeparator &
_
ConfigNames(i) & ModelPathExtension
If ModelDoc.SaveAs2(ModelSaveName, swSaveAsCurrentVersion, False, False) Then
If MsgBox("Fehler beim Speichern von " & ModelSaveName & " Abbrechen?", vbYesNo) = vbYes Then
End
End If
End If
' und Model wieder schließen
ModelTitle = ModelDoc.GetTitle
swApp.CloseDoc ModelTitle
Next i
' und ganz zum Schluß Original wieder öffnen
Set ModelDoc = swApp.OpenDoc6(ModelPathName, ModelDocType, 0, openconfig, errors, warnings)
End Sub
Private Function GetFullPathNoExtension(strPath As String) As String
'
Dim intCounter As Integer
' rückwärts bis zum Punkt suchen
For intCounter = Len(strPath) To 1 Step -1
If Mid$(strPath, intCounter, 1) = "." Then
Exit For
End If
Next intCounter
' und den Wert zurückgeben OHNE den Punkt
GetFullPathNoExtension = Left$(strPath, intCounter - 1)
End Function
Private Function GetExtensionOnly(strPath As String) As String
Dim intCounter As Integer
' rückwärts bis zum Punkt suchen
For intCounter = Len(strPath) To 1 Step -1
If Mid$(strPath, intCounter, 1) = "." Then
Exit For
End If
Next intCounter
' und den Wert zurückgeben OHNE den Punkt
GetExtensionOnly = Mid(strPath, intCounter)
End Function
| Kritik und Anregungen bitte an Stefan Berlitz. Letzte Änderung dieser Seite am Donnerstag, 01. Februar 2007 17:40 |