---

Guten Morgen zusammen

Wir möchten auf unserer neugestalteten Webseite von allen unseren Baugruppen eDrawings anbieten damit sich der Kunde ein Bild vom Produkt machen kann. Wenn ich aber von einer Baugruppe eine eDrawing erstelle sieht der Kunde alle Einzelteile und kann diese auch ausblenden. Dies wäre aber nicht erwünscht.
Also gibt es nichts anderes als jede Baugruppe als Part abzuspeichern und danach die eDrawings zu erstellen. Nur ist das Problem das wir ziemlich viele Baugruppen haben.
Hat jemand schon mal ein Makro dafür geschrieben?

Gruss Tom.

PS. Ich habe auch schon probiert eine VRML Datei zu erstellen, war aber mit dem Ergebnis nicht recht zufrieden.

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

---

save_as_part.zip

Hallo Tom,

hab mal was gebastelt 

Code:

---

' **********************************************************************
' * Makro speichert aktive Baugruppe als Part mit demselben Namen
' *
' * ACHTUNG: funktioniert erst ab SolidWorks 2003, es wird ohne
' * Rücksicht gespeichert, vorhandene Dateien werden überschrieben
' *
' * 12.11.2003 Stefan Berlitz (stefan.berlitz@solidworks.cad.de)
' * http://solidworks.cad.de
' * http://swtools.cad.de
' *
' **********************************************************************

Dim swApp As Object
Dim ModelDoc2 As Object
Dim filename As String
Dim version As Long
Dim options As Long
Dim errors As Long
Dim warnings As Long

Const swDocASSEMBLY = 2
Const swSaveAsCurrentVersion = 0             '  default

Const swSaveAsOptions_Silent = &H1           '  Save document silently or not
Const swSaveAsOptions_Copy = &H2             '  Save document as a copy or not
Const swSaveAsOptions_SaveReferenced = &H4           '  Save referenced documents or not (drawings and parts only)
Const swSaveAsOptions_AvoidRebuildOnSave = &H8               '  Avoid rebuild on Save or SaveAs, if swSaveAsOptions_Silent
Const swSaveAsOptions_UpdateInactiveViews = &H10             '  Update views of inactive sheets, if swSaveAsOptions_Silent
Const swSaveAsOptions_OverrideSaveEmodel = &H20         '  Override system setting for saving emodel data of document
Const swSaveAsOptions_SaveEmodelData = &H40          '  If OverrideSaveEmodel is True, use this as the value instead

Sub main()

    Set swApp = CreateObject("SldWorks.Application")
    Set ModelDoc2 = swApp.ActiveDoc

    If ModelDoc2 Is Nothing Then
        ' dann war gar kein Dokument geöffnet, wie soll da was funktionieren
        MsgBox "Kein Dokument geöffnet"
        Exit Sub
    End If
    If (ModelDoc2.GetType <> swDocASSEMBLY) Then
        ' wenn keine Assembly aktiv ist wird das Makro wieder beendet
        MsgBox "Nur für Baugruppen geeignet"
        Exit Sub
    End If

    ' dann den passenden Namen als Part zusammenbasteln
    filename = GetFullPathNoExtension(ModelDoc2.GetPathName) & "sldprt"
    version = swSaveAsCurrentVersion
    options = swSaveAsOptions_Copy
    ' abspeichern und Rückgabewert überprüfen oder
    ' einfach ignorieren
    If ModelDoc2.SaveAs4(filename, version, options, errors, warnings) Then
        MsgBox filename & " erfolgreich gespeichert"
    Else
        MsgBox "Hupps, ein Fehler beim speichern: " & errors & " - " & warnings
    End If

End Sub

Private Function GetFullPathNoExtension(strPath As String) As String
  '
  Dim intCounter As Integer

  ' rückwärts bis zum Punkt suchen
  For intCounter = Len(strPath) To 1 Step -1
    If Mid$(strPath, intCounter, 1) = "." Then
      Exit For
    End If
  Next intCounter

  ' und den Wert zurückgeben
  GetFullPathNoExtension = Left$(strPath, intCounter)

End Function

---

Ciao,
Stefan

------------------
Inoffizielle deutsche SolidWorks Hilfeseite
http://solidworks.cad.de

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

---

Hallo Stefan

Dass nenn ich Service. Danke Dir vielmal. Unities sind unterwegs.

Weisst Du was noch genial wäre? Ich möchte irgendwo im Makro den Pfad angeben wo die Datei gespeichert wird. Und wenn die Datei erstellt wurde sollte die Baugruppen geschlossen und NICHT gespeichert werden. Dies weil ich vor dem Erstellen der Teiledatei allen Teilen die gleiche Farbe zuweise, dies aber dann später in der Baugruppe nicht mehr so haben möchte.

Gruss Tom.

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

---

Hallo Tom,

ich weiß nicht, ob Ihr ein EDM-System einsetzt. Wenn ja, setz doch mal den Hersteller darauf an.     
Diese Teile müssen dann ja auch entsprechend verwaltet werden.
Wir haben da eine Funktion in unserer MaxxDB drin die diese Parts automatisch erstellt und eincheckt.

Wenn Ihr auf Filesystem-Ebene operiert, hat Stefan sicher noch was in petto..... 

Gruß.....Herrmann

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

Schlaue Sprüche gibt es genug - es gibt nur nicht genug Menschen die sie anwenden.

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

---

save_as_part_tom-special.zip

Hallo Tom,

you asked for ... you get it.    

Erweiterungen speziell für dich: du kannst den Pfad des Speicherortes einstellen, die Baugruppe wird geschlossen und das "neue" Teil sofort zur Weiterverarbeitung geöffnet.

Alles andere, was du machen willst, kann man sicher auch automatisieren (z.B. alle Komponenten vorher auf eine Farbe bringen und anschließend als eDrawing speichern); es soll Leute geben, die so etwas in einer Art Tauschhandel gegen kleine bedruckte Papierfetzen machen (ich übringes auch     )

Wenn du dass dann auf die Spitze treiben willst und das ganze im Batchbetrieb für viele Baugruppen machen willst kombinierst du solch ein Makro mit meinem PAC4SWX und lehnst dich gemütlich zurück, während SolidWorks von Geisterhand die eDrawings erzeugt.

Code:

---

' **********************************************************************
' * Makro speichert aktive Baugruppe als Part mit demselben Namen
' * schließt dann die Baugruppe und öffnet das "neue" Part
' *
' * ACHTUNG: funktioniert erst ab SolidWorks 2003, es wird ohne
' * Rücksicht gespeichert, vorhandene Dateien werden überschrieben
' *
' * 12.11.2003 Stefan Berlitz (stefan.berlitz@solidworks.cad.de)
' * http://solidworks.cad.de
' * http://swtools.cad.de
' *
' **********************************************************************

' *************** Pfad für Zielverzeichnis anpassen ********************
Const ZielPfad = "i:\temp\"
' *********************** Anpassung Ende *******************************

Dim swApp As Object
Dim ModelDoc2 As Object
Dim filename As String
Dim version As Long
Dim options As Long
Dim errors As Long
Dim warnings As Long

' SolidWorks Konstanten
Const swDocPART = 1
Const swDocASSEMBLY = 2
Const swSaveAsCurrentVersion = 0             '  default

Const swSaveAsOptions_Silent = &H1           '  Save document silently or not
Const swSaveAsOptions_Copy = &H2             '  Save document as a copy or not
Const swSaveAsOptions_SaveReferenced = &H4           '  Save referenced documents or not (drawings and parts only)
Const swSaveAsOptions_AvoidRebuildOnSave = &H8               '  Avoid rebuild on Save or SaveAs, if swSaveAsOptions_Silent
Const swSaveAsOptions_UpdateInactiveViews = &H10             '  Update views of inactive sheets, if swSaveAsOptions_Silent
Const swSaveAsOptions_OverrideSaveEmodel = &H20         '  Override system setting for saving emodel data of document
Const swSaveAsOptions_SaveEmodelData = &H40          '  If OverrideSaveEmodel is True, use this as the value instead

Sub main()

    Set swApp = CreateObject("SldWorks.Application")
    Set ModelDoc2 = swApp.ActiveDoc

    If ModelDoc2 Is Nothing Then
        ' dann war gar kein Dokument geöffnet, wie soll da was funktionieren
        MsgBox "Kein Dokument geöffnet"
        Exit Sub
    End If
    If (ModelDoc2.GetType <> swDocASSEMBLY) Then
        ' wenn keine Assembly aktiv ist wird das Makro wieder beendet
        MsgBox "Nur für Baugruppen geeignet"
        Exit Sub
    End If

    ' dann den passenden Namen als Part zusammenbasteln
    filename = ZielPfad & GetFilenNameNoExtension(ModelDoc2.GetPathName) & ".sldprt"
    version = swSaveAsCurrentVersion
    ' den Kommentar in der nächsten Zeile wieder einkommentieren, wenn
    ' ohne Rückfrage überschrieben werden soll
    options = swSaveAsOptions_Copy ' & swSaveAsOptions_Silent
    ' abspeichern und Rückgabewert überprüfen oder
    ' einfach ignorieren
    If ModelDoc2.SaveAs4(filename, version, options, errors, warnings) Then
        MsgBox filename & " erfolgreich gespeichert, Baugruppe wird geschlossen, Teil geöffnet"
        swApp.CloseDoc ModelDoc2.GetTitle
        swApp.OpenDoc filename, swDocPART
    Else
        MsgBox "Hupps, ein Fehler beim speichern: " & errors & " - " & warnings
    End If

End Sub

Private Function GetFilenNameNoExtension(strPath As String) As String
  '
  Dim intCounter As Integer
  Dim intCounter2 As Integer
  Dim strTmp As String

  ' Pfad abtrennen
  For intCounter = Len(strPath) To 1 Step -1
    ' It its a slash, grab the sub string
    If Mid$(strPath, intCounter, 1) <> "\" Then
      strTmp = Mid$(strPath, intCounter, 1) & strTmp
    Else
      Exit For
    End If
  Next intCounter
 
  ' und die Extension abtrennen
  For intCounter2 = Len(strTmp) To 1 Step -1
    If Mid$(strTmp, intCounter2, 1) = "." Then
      Exit For
    End If
  Next intCounter2

  ' und den Wert zurückgeben
  GetFilenNameNoExtension = Left$(strTmp, intCounter2 - 1)

End Function

---

Ciao,
Stefan

------------------
Inoffizielle deutsche SolidWorks Hilfeseite
http://solidworks.cad.de

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

---

Hi Stefan

Ich sage nichts mehr und bin wunschlos glücklich 
Du hast mir enorm geholfen, das ist genau das was ich gesucht habe.

Danke...   

Gruss Tom

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