---

Hallo Allerseits,
ich habe mir das Makro von Stefans Seite für unsere Bedürfnisse angepasst. Damit sollen Baugruppen nach der Freigabe in einem bestimmten Ordner auf dem Server mit dem Zusatz der Artikelnummer im Namen gespeichert werden. Das funktioniert soweit alles super, bis auf des Messen in der fertigen E-Drawing.
Frage: Gibt es irgendwo noch einen Parameter, den ich übersehen habe?

Hier der Code:

Code:

---

Dim swApp As Object
Dim ModelDoc2 As Object
Dim Part As Object
Dim Pdminfo As String
Dim ArtNrMech As String
Dim Dateiname As String
Dim Pfad As String

Sub main()

    Set swApp = CreateObject("SldWorks.Application")
    Set ModelDoc2 = swApp.ActiveDoc
   
   
    ' dann war gar kein Dokument geöffnet, wie soll da was funktionieren
    If ModelDoc2 Is Nothing Then
            MsgBox " Kein Dokument geöffnet! ", vbExclamation
        Exit Sub
    End If
   
    ' wenn keine Assembly aktiv ist wird das Makro wieder beendet
    If (ModelDoc2.GetType <> swDocASSEMBLY) Then
            MsgBox " Nur für Baugruppen geeignet! ", vbExclamation
        Exit Sub
    End If
   
    ' Status des PDM Systems ermitteln
    Set Part = swApp.ActiveDoc
    Pdminfo = Part.CustomInfo2("", "Status")
        If Not Pdminfo = "Freigegeben" Then
            MsgBox "Datei ist im PDM-System nicht freigegeben!", vbCritical
        End
        End If
   
   
    ' Ansichten aktualisieren, wenn erforderlich
    If errors = swDocNeedsRebuildWarning Then
    AssemblyDoc.EditRebuild
    End If
   
    'Die BG isometrisch fensterfüllend in Szene setzen
    Set swApp = CreateObject("SldWorks.Application")
    Set ModelDoc2 = swApp.ActiveDoc
    Part.ShowNamedView2 "*Isometrisch", 7
    Part.ViewZoomtofit2
 
    'Namen der BG holen
    Dateiname = ""
    Dateiname = Part.GetTitle
   
    'Artikelnummer Mechanik holen
    Set Part = swApp.ActiveDoc
    ArtNrMech = Part.CustomInfo2("", "Artikelnummer")
    If Not (Left(ArtNrMech, 1) = "M" And Len(ArtNrMech) = 8) Then
            MsgBox "Keine gültige Artikelnummer Mechanik vergeben!", vbCritical
        End
    End If
   
    'speichern unter dem beabsichtigten Netzlaufwerk
    Pfad = "P:\PRODUKTION VIDEO\PU Mechanik_EDrawing"
    Part.SaveAs2 Pfad + "\" + ArtNrMech + "_" + Dateiname + ".easm", 0, True, False
    MsgBox "Baugruppe wurde als " + ArtNrMech + "_" + Dateiname + ".easm gespeichert!", _
        vbInformation, "Save as EASM"
   

End Sub

---

Danke fürs lesen!  

------------------
Viele Grüße, THSEFA 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo THSEFA 

Geh in SolidWorks auf "Hilfe" - "API-Themen", Register "Suchen" und gib
die Suchwörter "save" "options" "edrawing" ein.

Somit kommt der Treffer "File > SaveAs > Saveas type > eDrawings > ....."

Da sind die Optionen beschrieben.

Gruss
Mike

------------------

The Power Of Dreams

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hier noch der ganze Code, musste ihn auch zuerste erstellen 

Code:

---

Set swApp = Applicatio.SldWorks
Set Part = swApp.ActiveDoc

retval = swApp.SetUserPreferenceToggle(swEDrawingsOkayToMeasure, True)

---

Hoffe es hat keine Drückfehler drin. Bei uns ist das CAD-Netzwerk ein Inselnetzwerk ohne Internet......

Damit wird das Flag gesetzt. Diese Einstellung bleibt in SWX erhalten, ist keine temporäre Einstellung!

------------------

The Power Of Dreams

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Vielen Dank, Mike! Fühle dich mit Unities und dem Dank unserer Monteure überhäuft.
Habe den Code eingefügt und es hat auf Anhieb funktioniert! 

------------------
Viele Grüße, THSEFA 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP