Forum:SolidWorks
Thema:Benutzerdefinierte Eigenschaften übertragen
Möchten Sie sich registrieren?
Wer darf antworten? Registrierte Benutzer können Beiträge verfassen.
Hinweise zur Registrierung Sie müssen registriert sein, um Beiträge oder Antworten auf Beiträge schreiben zu können.
Ihr Benutzername:
Ihr Kennwort:   Kennwort vergessen?
Anhang:    Datei(en) anhängen  <?>   Anhänge verwalten  <?>
Grafik für den Beitrag:                                                
                                                       
Ihre Antwort:

Fachbegriff
URL
Email
Fett
Kursiv
Durchgestr.
Liste
*
Bild
Zitat
Code

*HTML ist AUS
*UBB-Code ist AN
Smilies Legende
Netiquette

10 20 40

Optionen Smilies in diesem Beitrag deaktivieren.
Signatur anfügen: die Sie bei den Voreinstellungen angegeben haben.

Wenn Sie bereits registriert sind, aber Ihr Kennwort vergessen haben, klicken Sie bitte hier.

Bitte drücken Sie nicht mehrfach auf "Antwort speichern".

*Ist HTML- und/oder UBB-Code aktiviert, dann können Sie HTML und/oder UBB Code in Ihrem Beitrag verwenden.

T H E M A     A N S E H E N
Wahui

Beiträge: 15 / 0

Dell M4800
Windows 7 Professional x64
Intel(R) Core i7 @ 2,8GHz
NVIDIA Quadro K1000M
16GB RAM
SWX 2014 Premium x64 SP2

Hallo Stefan,
danke für die Hilfe. Ich habe das Makro mal "fertig" gestellt. Nicht ganz einfach für einen Noob. Aber es funktioniert!

Das Makro überträgt die Sachnummer (Syntax XXX-XXXX) aus den benutzerdefinierten Eigenschaften des Bauteils.
Speichert Bauteil oder BG unter der Sachnummer ab.
Speichert die Zeichnung unter der Sachnummer ab.
Legt ein PDF der Zeichnung unter einem Pfad, welcher von der Sachnummer abhängt, ab.

Ist der Aufbau sinnvoll?

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


Gruß

Dennis