Code:
Dim swApp As Object' Definitionen sind konsistent mit dem Typennamen
' wie in \SldWorks\samples\appComm\swconst.bas definiert
Const swDocPART = 1
Const swDocASSEMBLY = 2
Const swDocDRAWING = 3
Sub Artikel_einchecken()
' **********************************************************************
' * Beispielcode: Das Makro sucht für die aktive Zeichnung (aktuelles
' * Blatt) das referenzierte Modell raus. Dazu wird aus den
' * Blatteigenschaften gelesen, welche Zeichenansichten das
' * referenzierte Modelle enthalten soll, Standard bedeutet einfach der
' * erste eingefügte View
' *
' * Quelle http://ww3.cad.de/foren/ubb/Forum2/HTML/021310.shtml#000000
' * StefanBerlitz @ cad.de
' **********************************************************************
Dim swApp As Object
Dim DrawingDoc As Object
Dim Sheet As Object
Dim View As Object
Dim RefModelView As String
Dim RefModelName As String
' an die laufende SolidWorks Sitzung anhängen
Set swApp = Application.SldWorks
' prüfen, ob überhaupt ein Dokument offen ist ...
Set DrawingDoc = swApp.ActiveDoc
If DrawingDoc Is Nothing Then
MsgBox "Kein Dokument offen"
Exit Sub
End If
' ... und ob das auch eine Zeichnung ist
If (DrawingDoc.GetType <> swDocDRAWING) Then
MsgBox "Nur für Zeichnungen sinnvoll"
Exit Sub
End If
' dann schauen wir mal nach dem aktuellen Blatt
Set Sheet = DrawingDoc.GetCurrentSheet
' von dem Blatt schauen wir uns die Zeichenansicht aus, die auch für
' Dateieigenschaften zuständig ist
RefModelView = Sheet.CustomPropertyView
' dann durch die Zeichenansichten durchklappern, bis der gewünschte
' View gefunden wurde. Dazu einfach die Namen vergleichen.
' "Standard" bedeutet der erste View
Set View = DrawingDoc.GetFirstView
' muss für nicht deutsches Englisch angepasst werden
If RefModelView = "Standard" Then
' dann brauchen wir nur auf den ersten View zu springen
Set View = View.GetNextView
Else
' ansonsten solange weiterklappern bis wir den passenden
' View gefunden haben
Do While Not View Is Nothing
' nächste Zeichenansicht
Set View = View.GetNextView
' bis wir den passenden View gefunden haben
If View.GetName2 = RefModelView Then Exit Do
Loop
End If
' so jetzt sollte die Ansicht mit dem referenzierten Modell aktiv sein
If Not View Is Nothing Then
RefModelName = View.GetReferencedModelName
Else
' oh, dann gibt es den View nicht, leere Zeichnung?
MsgBox "Kein referenziertes Modell gefunden, Zeichnung leer?"
End If
'***************************************************************************************
'*Sucht im referenziertem Bauteil nach der Sachnummer
'*Quelle http://ww3.cad.de/foren/ubb/Forum2/HTML/013243.shtml#000001
'*tbd @ cad.de
'***************************************************************************************
Dim oDrawingDoc As SldWorks.DrawingDoc
Dim oView As SldWorks.View
Dim sModelName As String
Dim oSwPartModel As SldWorks.ModelDoc2
Dim oSwViewPartModel As SldWorks.ModelDoc2
Set oSwApp = Application.SldWorks
Set oSwModel = oSwApp.ActiveDoc
Set oDrawingDoc = oSwModel
'Das ist das Blatt
Set oView = oDrawingDoc.GetFirstView()
'Die erste Ansicht im Blatt
Set oView = oView.GetNextView
'Dokument der Ansicht
sModelName = oView.GetReferencedModelName
'Jetzt hast du einen Pfad und kannst in den geöffneten ModelDocs nach dem richtigen Suchen.
Set oSwPartModel = oSwApp.GetFirstDocument
Do While Not oSwPartModel Is Nothing
'Haben wir das richtige ModelDoc?
If oSwPartModel.GetPathName = sModelName Then
'Gefunden!
Set oSwViewPartModel = oSwPartModel
Exit Do
End If
Set oSwPartModel = oSwPartModel.GetNext
Loop
'Dokumenteneigenschaft
If Not oSwViewPartModel Is Nothing Then
Index = oSwViewPartModel.CustomInfo2(glbConfName, "Sachnummer")
End If
'***************************************************************************************
'*Ermittelt, ob Baugruppe oder Bauteil auf Zeichnung abgebildet ist.
'*Speichert Bauteil/BG unter der, in den Benutzerdefinierten Eigenschaften gespeicherten Sachnummer
'*Quelle http://www.mysldworks.de/Details.aspx?ThemaID=14&SnippetID=104
'*Daniel Bühling @ mysolidworks.de
'***************************************************************************************
Dim sExtension As String
Dim Dateiendung As String
sFullpath = oSwViewPartModel.GetPathName
sExtension = Right(sFullpath, Len(sFullpath) - InStrRev(sFullpath, "."))
oSwViewPartModel.SaveAs (Index + "." + sExtension)
'***************************************************************************************
'*Speichert Zeichnung unter der, in den Benutzerdefinierten Eigenschaften gespeicherten Sachnummer
'***************************************************************************************
oDrawingDoc.SaveAs (Index + ".slddrw")
'***************************************************************************************
'*Zerlegt den Dateinamen (Sachnummer) in seine Bestandteile
'*damit später der Ordner unter der Sachnummer angelegt werden kann
'*Quelle http://www.herber.de/forum/archiv/612to616/612774_Einen_String_Zerlegen.html
'*UweD @ herber.de
'***************************************************************************************
Dim Dateiname As String
Dim Eingabe As String
Dim Laufwerk As String
Dim Pfad As String
Dim Var1, Var2 As String
Dim P1 As Integer
Dim Part As Object
Laufwerk = "C:\Temp\" 'der Pfad kann angepasst werden
Dateiname = oSwViewPartModel.CustomInfo2(glbConfName, "Sachnummer")
P1 = InStr(Dateiname, "-") 'Pos vom Trennstrich
Var1 = Left(Dateiname, P1 - 1)
Var2 = Mid(Dateiname, P1 + 1)
Pfad = Laufwerk & Var1 & "\" & Var1 & "-" & Var2 & "\"
'***************************************************************************************
'*Überprüfung ob Order bereits existiert. Wenn ja, dann den Dateipfad im Explorer aufrufen.
'*Box mit Dateinamen-Abfrage anzeigen.Wenn er nicht existiert, den Dateipfad erzeugen.
'*Quelle http://www.herber.de/forum/archiv/372to376/372604_Per_VBA_Ordner_anlegen.html
'*K.Rola @ herber.de
'*Funktioniert nur, wenn nur noch der unterste Ordner anzulegen ist. Sonst Schleife nötig
'***************************************************************************************
If Dir(Pfad, vbDirectory) <> "" Then
Shell "Explorer.exe " & Pfad, vbNormalFocus
Eingabe = InputBox("Bitte Dateiname für PDF-Datei eingeben:", "Als PDF speichern", Dateiname + ".pdf")
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
swApp.ActiveDoc.ActiveView.FrameState = 1
Part.SaveAs2 Pfad + Eingabe, 0, True, False
Else
MkDir (Pfad)
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
swApp.ActiveDoc.ActiveView.FrameState = 1
Part.SaveAs2 Pfad + "\" + Dateiname + ".pdf", 0, True, False
End If
End Sub