' ******************************************************************************
' Revisionskopien speichern
' This macro saves a copy of the actual doc in the same folder for documentation.
' If the doc is a drawing, the referenced model can be saved as copy, too.
' A revision index is attached to the filename.
' P. Sach
' Version 1.0 21.10.05
' Version 1.1 30.11.05 Referenziertes Modell wird still geöffnet
' ******************************************************************************
Option Explicit
Public Index As String
Public Anhang As String
Public NewName As String
Public swApp As Object
Public Model As Object
Public reference As Object
Public OldName As String
Public ShortOldName As String
Public activetype As Integer
Public reftype As Integer
Public RefModelName As String
Public refname As String
Public ShortRefName As String
Public prtenabled As Boolean
Public drwenabled As Boolean
Public assyenabled As Boolean
Public Const swStepAP = 75
Public nErrors As Long
Public nWarnings As Long
'Public Enum OpenDocOptions_e
Public Const swOpenDocOptions_Silent = 1
Public Const swOpenDocOptions_ReadOnly = 2
Public Const swOpenDocOptions_ViewOnly = 4
Public Const swOpenDocOptions_RapidDraft = 8
Public Const swOpenDocOptions_LoadModel = 16
Public Const swOpenDocOptions_AutoMissingConfig = 32
'Public Enum DocumentTypes_e
Public Const swDocNONE = 0
Public Const swDocPART = 1
Public Const swDocASSEMBLY = 2
Public Const swDocDRAWING = 3
Public Const swDocSDM = 4
Sub main()
Dim nErrors As Long
Dim nWarnings As Long
Dim nretval As Long
Set swApp = Application.SldWorks
' Set swApp = CreateObject("SldWorks.Application") ' an SolidWorks anklinken
Set Model = swApp.ActiveDoc
If Model Is Nothing Then ' Wenn kein Dokument offen ist,
MsgBox ("Kein SolidWorks-Dokument geöffnet") ' Meldung
Exit Sub ' und raus
End If
OldName = Model.GetPathName() ' Pfadnamen auslesen / get path name
ShortOldName = Left(OldName, Len(OldName) - 7) ' Dateiendung abschneiden / cutoff ".slddrw"
activetype = Model.GetType
If (Model.GetType = swDocDRAWING) Then
activetype = 3 ' Wenn Zeichnung, dann
getreftype ' Typ des referenzierten Modells holen
ElseIf (Model.GetType <> 3) Then
refname = OldName ' wenn aktives Doc ein Teil oder Assy ist / if active doc is a part or assy
Set reference = swApp.ActiveDoc
End If
If Model.EditRebuild3() Then ' Anzeige der Zeichnungsansichten aktualisieren / rebuild
Else
MsgBox "This model has rebuild errors!"
End If
frmEingabe.Show ' ruft das Eingabefenster auf
End Sub
Sub getreftype() ' ermittelt das in einer Zeichnung refenzierte Modell / gets the referenced model in a drawing
Dim view As Object ' und dessen Namen incl. Pfad / and it's filename and path
Dim bRetval As Boolean
Dim nErrors As Long
Dim nWarnings As Long
Dim retval As Object
Dim nDocType As Long
' Hier wird geprüft, ob das aktive Dokument eine Zeichnung ist (GetType=3)
' Wenn Model eine Zeichnung ist, wird das von der Zeichnung referenzierte
' Dokument aktiviert
If Model.GetType = swDocDRAWING Then
Set retval = Model.GetFirstView ' FirstView ist das Blatt
Set view = retval.GetNextView ' Dies ist die erste Ansicht
If view Is Nothing Then
Exit Sub
End If
' Name des referenzierten Modells holen / gets referenced model's name
RefModelName = view.GetReferencedModelName
' Typ des referenzierten Docs anhand der Endung erkennen
If InStr(LCase(RefModelName), "sldprt") > 0 Then ' LCase wandelt string in Kleinbuchstaben um
nDocType = swDocPART ' InStr gibt die Position des Suchtextes zurück
ElseIf InStr(LCase(RefModelName), "sldasm") > 0 Then
nDocType = swDocASSEMBLY
ElseIf InStr(LCase(RefModelName), "slddrw") > 0 Then
nDocType = swDocDRAWING
Else
' Probably not a SolidWorks file...
nDocType = swDocNONE
MsgBox ("Referenzdatei kann nicht geöffnet werden")
Exit Sub
End If
' Referenziertes Modell zum aktiven Dokument machen / activates referenced model
' Set reference = swApp.ActivateDoc2(RefModelName, True, nErrors)
Set reference = swApp.OpenDoc6(RefModelName, nDocType, swOpenDocOptions_Silent, "", nErrors, nWarnings)
refname = reference.GetPathName()
reftype = reference.GetType
If (reftype < 1 Or reftype > 2) Then
MsgBox ("Kein Referenztyp gefunden")
End If
' Damit ist alles über das refernzierte Doc bekannt
' Zeichnung wieder zum aktuellen Dokument machen / activates drawing again
Set Model = swApp.ActivateDoc2(OldName, True, nErrors)
End If
End Sub
Das Öffnen des referenzierten Modells findet in der sub getreftype() statt. Ich hoffe, das hilft dir weiter.
Piet
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP