|
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 32 Dateieigenschaften kopieren |
|
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.
Dieses Makro kam auf Wunsch im Thread konfigurationsspezifische Eigenschaften mit Macro löschen? zu Stande, wo nach einer Möglichkeit gesucht wurde, bei Hunderten von Dateien die konfigurationsspezifischen Eigenschaften in die "normalen" Dateieigenschaften zu übertragen. Dieses Makro dient diesem Zweck, arbeitet für sich nur mit dem aktuellen Dokument, in Zusammenspiel mit PAC4SWX jedoch auf eine beliebige Anzahl von Dateien und ganzen Verzeichnissen. Achtung, muss angepasst werden, damit es auch speichert, siehe Kommentar im Header.
' **********************************************************************
' Makro kopiert alle konfigurationsspezifischen Dateieigenschaften auf
' Dateieigenschaften. Dabei werden die Namen und Werte beibehalten.
' Bereits vorhandene Dateieigenschaften werden ohne Rückfrage
' überschrieben. Wenn konfigurationsspezifische Werte eingetragen
' sind (wie z.B. Masse etc.) wird sich das weiterhin auf diese
' Konfiguration beziehen.
'
' Es wird die aktuelle Konfiguration beim Aufrufen des Makros genutzt
' Wenn immer eine bestimmte benannte Konfiguration genutzt werden soll
' diese unten in der Variable anpassen.
'
' 13.07.2005 Stefan Berlitz
' Stefan.Berlitz@solidworks.cad.de
' http://solidworks.cad.de
' http://swtools.cad.de
' **********************************************************************
'
' diese folgenden Werte können editiert werden
'
' mySaveDoc steuert, ob das Dokument automatisch unter dem aktuellen
' Namen ohne Sicherung gespeichert wird. 0 = aus 1 = ein
Const mySaveDoc = 0
'
' myStdKonf gibt den Namen der Konfiguration an, die als Quelle
' genutzt werden soll. Leerer String bedeutet aktuelle Konfiguration
Const myStdKonf = ""
' myDelKonfProp steuert, ob die konfigurationsspezifischen Eigenschaften
' nach dem übertragen gelöscht werden sollen 0 = erhalten 1 = löschen
Const myDelKonfProp = 0
' NICHT MEHR AB HIER EDITIEREN, es sei denn Sie wissen was sie tun ;-)
' **********************************************************************
' Definitions of typenames are consistent as in swconst.bas
Option Explicit
Const swDocPART = 1
Const swDocASSEMBLY = 2
Const swDocDRAWING = 3
Public Enum swCustomInfoType_e
swCustomInfoUnknown = 0
swCustomInfoText = 30 ' VT_LPSTR
swCustomInfoDate = 64 ' VT_FILETIME
swCustomInfoNumber = 3 ' VT_I4
swCustomInfoYesOrNo = 11 ' VT_BOOL
End Enum
Sub Main()
Dim swApp As Object
Dim ModelDoc As Object
Dim Configuration As Object
Dim ActConfName As String
Dim PropNames As Variant
Dim Prop As Variant
Dim PropType As Long
Dim PropText As String
Dim dummy
Set swApp = CreateObject("SldWorks.Application")
Set ModelDoc = swApp.ActiveDoc
If ModelDoc Is Nothing Then
' Call MsgBox("Keine Datei geöffnet", vbOKOnly, "Information")
Exit Sub
End If
'
' dann die aktuelle Konfiguration bestimmen
' den Name holen, wenn oben nicht eine bestimmte Konfiguration vorgegeben war
If myStdKonf = "" Then
Set Configuration = ModelDoc.GetActiveConfiguration
ActConfName = Configuration.Name
Else
ActConfName = myStdKonf
End If
' dann alle Dateieigenschaften aus der Konfiguration holen
PropNames = ModelDoc.GetCustomInfoNames2(ActConfName)
If Not IsEmpty(PropNames) Then
For Each Prop In PropNames
' Eigenschaft aus Konfig auslesen
PropType = ModelDoc.GetCustomInfoType3(ActConfName, Prop)
PropText = ModelDoc.CustomInfo2(ActConfName, Prop)
' und als Dateieigenschaft wieder einsetzen
' dazu sicherheitshalber eine ggf vorhandene löschen
dummy = ModelDoc.DeleteCustomInfo2("", Prop)
' und neu hinzufügen
dummy = ModelDoc.AddCustomInfo3("", Prop, PropType, PropText)
Next
' dann die KonfProps löschen, falls gewünscht
If myDelKonfProp = 1 Then
For Each Prop In PropNames
' Eigenschaft aus Konfig löschen
dummy = ModelDoc.DeleteCustomInfo2(ActConfName, Prop)
Next
End If
End If
' und zum Schluß noch speichern, wenn gewünscht
If mySaveDoc = 1 Then
If ModelDoc.SaveSilent Then
' dann hat es irgendeinen Fehler beim Speichern gegeben
MsgBox "Fehler beim Speichern."
Else
Debug.Print "Erfolgreich gespeichert"
End If
End If
End Sub
| Kritik und Anregungen bitte an Stefan Berlitz. Letzte Änderung dieser Seite am Mittwoch, 11. Juli 2007 17:52 |