---

Guten Tag!

ich breuchte eine Makro welche alle Bauteile und Unterbauteile (NICHT die Baugruppe selbst) in folgendem ordner als iges kopie abspeichert:

%PROJEKTORDNER%/IGES/TAG_MONAT_JAHR

Falls die Datei schon vorhanden ist wird sie überschrieben. Der Dateiname bleibt gleich wie bei der original ipt. Optimal wäre es wenn alle Bauteile welche als Material "Inox" eingestellt haben NICHT als iges abgespeichert werden..

kann mir da jemand bitte weiterhelfen??

Danke

Mfg

Alcom

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

---

Ich hab inzwischen einiges erreicht.. jetzt fehlt nur noch der teil der den IGES am richtigen Pfad abspeichert.. einige Tipps?? danke

Code:

---

Public Sub saveiges()
    ' Get the active assembly.
    Dim oAsmDoc As AssemblyDocument
    Set oAsmDoc = ThisApplication.ActiveDocument

    ' Get all of the referenced documents.
    Dim oRefDocs As DocumentsEnumerator
    Set oRefDocs = oAsmDoc.AllReferencedDocuments

    ' Iterate through the list of documents.
    Dim oRefDoc As Document
            Dim datedate As Date
            datedate = DateValue(Now)
            Dim datetxt As String
            datetxt = (Replace(datedate, "/", "_"))
            Path = Mid(sCurrentProject, 1, InStrRev(sCurrentProject, "\")) & "130 cam\" & datetxt & "\"
           
    For Each oRefDoc In oRefDocs
         Dim invcustompropertyset As PropertySet
            
           
            ' Get the PropertySets object.
            Dim oPropSets As PropertySets
            Set oPropSets = oRefDoc.PropertySets
       
            ' Get the design tracking property set.
            Dim oPropSet As PropertySet
            Set oPropSet = oPropSets.Item("Design Tracking Properties")
       
            ' Get the part number iProperty.
            Dim oPartNumiProp As Property
            Set oPartNumiProp = oPropSet.Item("Material")
           
           
            If ((oRefDoc.DocumentType = 12290) And (oPartNumiProp.Value <> "Inox")) Then
           

                ' Debug.Print oPartNumiProp.Value
           
            End If
           
 
    Next
End Sub

---

[Diese Nachricht wurde von Alcom am 01. Jul. 2010 editiert.]

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

---

Hey!
Als Iges abspeichern gehts so:

Sub IPT()

Dim oDoc As Document
Dim oDoc2 As String
Dim vLink As String
Dim outFile As String

vLink = "dein Link"

Set oDoc = ThisApplication.ActiveDocument
oDoc2 = vLink & Left(oDoc.DisplayName, Len(oDoc.DisplayName) - 4) & ".iges"

On Error Resume Next
oDoc.SaveAs oDoc2, True

End Sub

"oDoc.DisplayName" nimmt den vorhandenen Namen der Datei, "Len(oDoc.DisplayName)-4" schneidet die vorhandene .ipt Endung ab und & ".iges" fügt die IGES Endung an. "oDoc.SavaAs odoc2, True" speichert das ganze dann ab.
lg Bigles

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