|
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 27 Baugruppe speichern als Teil |
|
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.
Update: beide Varianten aus dem angelinkten Thread im Download integriert, im Makro save_as_part-in-targetdir.swp muss im Makro erst noch der Zielpfad entsprechend Ihrer Umgebung eingestellt werden, so dass das gespeicherte Teil nicht im Verzeichnis der Baugruppe sondern in einem Sammelverzeichnis landen.
Siehe auch http://ww3.cad.de/foren/ubb/Forum2/HTML/004247.shtml
' **********************************************************************
' * Makro speichert aktive Baugruppe als Part mit demselben Namen im
' * Ordner der Baugruppe, schließt dann die Baugruppe (ohne Rückfrage)
' * und ruft das neue Teil dann zur Weiterverarbeitung auf
' *
' * ACHTUNG: funktioniert erst ab SolidWorks 2003, es wird mit
' * Rückfrage gespeichert, vorhandene Dateien werden nicht einfach
' * überschrieben (kann durch Option unten geändert werden)
' *
' * 12.11.2003 Stefan Berlitz (stefan.berlitz@solidworks.cad.de)
' * http://solidworks.cad.de
' * http://swtools.cad.de
' *
' **********************************************************************
Dim swApp As Object
Dim ModelDoc2 As Object
Dim filename As String
Dim version As Long
Dim options As Long
Dim errors As Long
Dim warnings As Long
Const swDocPart = 1
Const swDocASSEMBLY = 2
Const swSaveAsCurrentVersion = 0
Const swSaveAsOptions_Silent = &H1 ' Save document silently or not
Const swSaveAsOptions_Copy = &H2 ' Save document as a copy or not
Const swSaveAsOptions_SaveReferenced = &H4 ' Save referenced documents or not (drawings and parts only)
Const swSaveAsOptions_AvoidRebuildOnSave = &H8 ' Avoid rebuild on Save or SaveAs, if swSaveAsOptions_Silent
Const swSaveAsOptions_UpdateInactiveViews = &H10 ' Update views of inactive sheets, if swSaveAsOptions_Silent
Const swSaveAsOptions_OverrideSaveEmodel = &H20 ' Override system setting for saving emodel data of document
Const swSaveAsOptions_SaveEmodelData = &H40 ' If OverrideSaveEmodel is True, use this as the value instead
Sub main()
Set swApp = CreateObject("SldWorks.Application")
Set ModelDoc2 = swApp.ActiveDoc
If ModelDoc2 Is Nothing Then
' dann war gar kein Dokument geöffnet, wie soll da was funktionieren
MsgBox "Kein Dokument geöffnet"
Exit Sub
End If
If (ModelDoc2.GetType <> swDocASSEMBLY) Then
' wenn keine Assembly aktiv ist wird das Makro wieder beendet
MsgBox "Nur für Baugruppen geeignet"
Exit Sub
End If
' dann den passenden Namen als Part zusammenbasteln
filename = GetFullPathNoExtension(ModelDoc2.GetPathName) & "sldprt"
version = swSaveAsCurrentVersion
' den Kommentar in der nächsten Zeile wieder einkommentieren, wenn
' ohne Rückfrage überschrieben werden soll
options = swSaveAsOptions_Copy ' & swSaveAsOptions_Silent
' abspeichern und Rückgabewert überprüfen oder
' einfach ignorieren
If ModelDoc2.SaveAs4(filename, version, options, errors, warnings) Then
MsgBox filename & " erfolgreich gespeichert, Baugruppe wird geschlossen, Teil geöffnet"
swApp.CloseDoc ModelDoc2.GetTitle
swApp.OpenDoc filename, swDocPart
Else
MsgBox "Hupps, ein Fehler beim speichern: " & errors & " - " & warnings
End If
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
GetFullPathNoExtension = Left$(strPath, intCounter)
End Function
| Kritik und Anregungen bitte an Stefan Berlitz. Letzte Änderung dieser Seite am Donnerstag, 01. Februar 2007 17:40 |