---

VorlageBlech(mm).ipt.txt

Hallo Inventor-Gemeinde,

ich habe ein Problem. Unser Fertigungsbetrieb benötigt von uns dxf-Dateien der Abwicklungen (Blechteile). Nun wollen wir das ganze automatisieren. Und zwar so dass die dxf-Datei den gleichen Namen erhalten und am gleichen Speicherort liegen wie die IPT-Dateien. Das habe ich auch vom Code her hinbekommen (Der Suchfunktion sei Dank). Ich habe folgenden Code als 'Modul' über das VBA eingebunden:

'The sample code below writes a sheet metal file out as DXF. DWG is also supported. There are several optional arguments that can be specified as part of the format string. Below are the names of these arguments and their default values. The output will use these values unless you override them as part of the input string.
'TangentLayer = "IV_TANGENT"
'BendLayer = "IV_BEND"
'ToolCenterLayer = "IV_TOOL_CENTER"
'ArcCentersLayer = "IV_ARC_CENTERS"
'OuterProfileLayer = "IV_OUTER_PROFILE"
'FeatureProfilesLayer = "IV_FEATURE_PROFILES"
'InteriorProfilesLayer = "IV_INTERIOR_PROFILES"
'AcadVersion = "2000" (Can be "R12", "R13", "R14", or "2000")
'The following sample demonstrates creating an R12 DXF file that will have a layer called "Outer" where the curves for the outer shape will be created.
Public Sub WriteSheetMetalDXF()
    ' Get the active document.  This assumes it is a part document.
    Dim oDoc As PartDocument
    Set oDoc = ThisApplication.ActiveDocument
   
        ' Ermitteln des Standortes und des Names der IPT.
    ' Die Abwicklung (DXF-Datei) wird in den gleichen Pfad geschrieben, wo die IPT steht.
    ' Sie hat den gleichen Namen wie die IPT - nur die Extension ist .DXF .
   
    sDisplayName = oDoc.DisplayName
    sFullName = oDoc.FullFileName
    sName = Left$(sDisplayName, Len(sDisplayName) - 4) + ".dxf"
    sPath = Left$(sFullName, Len(sFullName) - Len(sDisplayName))

    ' Get the DataIO object.
    Dim oDataIO As DataIO
    Set oDataIO = oDoc.ComponentDefinition.DataIO

    ' Build the string that defines the format of the DXF file.
    Dim sOut As String
    sOut = "FLAT PATTERN DXF?AcadVersion=2000&OuterProfileLayer=0&BendLayer=BIEGELINIE&TangentLayer=H&InteriorProfilesLayer=0&ToolCenterLayer=H&ArcCentersLayer=H&FeatureProfilesLayer=0"

    ' Create the DXF file.
    'oDataIO.WriteDataToFile sOut, "c:\test.dxf"
    oDataIO.WriteDataToFile sOut, sPath + sName

End Sub

Dieser wird von einer AutoSave Prozedur aufgerufen.
Aber...von da an ging es bergab  . Speicher ich das Ganze als Vorlage kann ich wenn ich über diese ein Blechteil erstellen will keine Laschen mehr erstellen. Es kommt die Fehlermeldung keine Biegezone gefunden.
Hat jemand eine Idee wie ich das Problem in den Griff bekommen kann? Ich stelle hierfür die Vorlagendatei ins Netz.
Für jede Hilfe bin ich echt riesig dankbar  .

Gruss Headde

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

---

Hi!
Aaalso hier bist ja komplett von soowaas falsch  .
Das gehört ins Inventor VBA Forum, und da schiebe ich den Thread jetzt auch hin  .

BTW: Grüß mir die Schwäbische Alb. Und wenn Du mal nebenan in Ellwangen bist, dann mach ein paar Bilder vom Sänftenrennen nächsten Sommer. Das ist im Netz immer so schwach vertreten  ...

------------------
lg      
Tom

...so geht mein Boot manchmal unter...

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

---

Hallo headde,

warum machst du nicht einfach eine idw, die brauch man ja wahrscheinlich sowieso.
Dann kannst du mit:

Public Sub odxf()

Dim odoc As Inventor.Document
.
.
.
odoc.SaveAs (xxx.dxf)
End Sub

ein dxf erstellen. Genauen Code kann ich morgen posten.

Gruß
Reinhard

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

---

Hallo Reinhard,

also auf die Idee bin ich noch gar ned gekommen. Also wir stellen die Abwicklung auf der Zeichung immer dar, sofern es ein Teil zum Kanten ist. Wie ist das bei Teilen von denen nur die Erstansicht dargestellt wird, weil es beispielsweise nur eine Platte mit Bohrungen ist... 
Zudem wird bei uns die Abwicklung immer in dem Masstab wie sie halt am besten hinpasst dargestellt, also mal 1:10, 1:2 usw.
Für einen Code Ansatz oder Code bin ich mega dankbar.

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

---

Hallo headde,

es ist so wie getern schon gesagt odoc.saveas(pfad & xxx.dxf) schreibt ein dxf. Mit einer anderen Endung kriegst du entsprechen eine andere Datei, z.B. dwg odere step von einem ipt.
Den Pfad kannst du frei wählen oder aus odoc.fullfilename generieren, wenn die dxf im gleichen Ordner wie die idw liegen soll.

Gruß
Reinhard

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

---

Hi zusammen,

das hier dürfte klappen:
wenn es ein zip wird unter den Optionen 1x Pack&Go deaktivieren

Sub SaveAsDxf()
Dim dDoc As DrawingDocument
Dim fso As Object
Set fso = CreateObject("Scripting.FilesystemObject")
Dim ret As Variant
Set dDoc = ThisApplication.ActiveDocument
If dDoc Is Nothing Then Exit Sub
If Len(Trim(dDoc.FullFileName)) > 0 Then
      outFile = fso.GetParentFolderName(dDoc.FullFileName) & "\" & fso.GetBaseName(dDoc.FullFileName) & ".dxf"
        dDoc.SaveAs outFile, True
Else
        MsgBox "Erst Speichern", vbInformation
End If
   
End Sub

Gruß
Micha

------------------
Stell dir vor, es geht, und keiner kriegts hin.

Zitat:

---

Interpunktion und Orthographie des Postings sind frei erfunden.
Eine Übereinstimmung mit aktuellen oder ehemaligen Regeln wäre rein zufällig und ist nicht beabsichtigt.

---

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

---

Eine ganz doofe Frage....was wird da jetzt genau als dxf rausgeschrieben? Alle Ansichten wenn ich mehrere auf meiner Zeichnung hab, oder nur die Ansicht der Abwicklung?

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

---

einfach die ganze idw, auch mit mehreren Blättern

@VBSpawn:
wenn du Dateine mit Apprentice speicherst, und dabei den Dateinamen änderst führt das immmer zu Dateien deren Healthstatus nicht uptodatehealth ist.
Du wirst ja auch die Bauteilnummer an den neuen Dateinamen anpassen oder? Und wenn du die Zeichnungjetzt mit InventorView anschaust steht immer noch die alte Bauteilnummer im Schriftfeld. Die Datei muß mit Inventor geöffnet und gespeichert werden.

Gruß
Reinhard

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

---

Hi Reinhard,

Ich bin mir jetzt nicht sicher wie du auf den Apprentice kommst ... aber das stimmt nicht ganz... (Ich denke mal es geht um einen älteren Beitrag von mir) jedenfalls kann man komplett ohne Gefährdung des HealthStatus eine BGR verschieben+ mit neuem Namen versehen... dies funzt prima mit allen ipt's und der Top- Baugruppe.... solange sich dort keine weitere Unterbgr befinden klappt das....
Hatte das Thema auch mit ADESK besprochen, da ich jedesmal beim umkopieren via Apprentice die OutOfDate Meldung beim Öffnen im Inventor bekommen habe (allerdings nur wegen den Unterbaugruppen).

achja hier noch ein kleines Zitat von Adesk :You won't get that message anymore on Inventor 11(I checked this point a moment ago.).

Gruß
Micha

------------------
Stell dir vor, es geht, und keiner kriegts hin.

Zitat:

---

Interpunktion und Orthographie des Postings sind frei erfunden.
Eine Übereinstimmung mit aktuellen oder ehemaligen Regeln wäre rein zufällig und ist nicht beabsichtigt.

---

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

---

Hallo headde,

muss ich dir recht geben, mit einer ganzen idw als dxf, kann ich auch nichts anfenagen, wir brauchen es auch als einzetteil dxf!!

zum dwg erzeugen, may be brauchbar, muss  ich testen....

wenns was neues gibt, für ne geile dxf Erstellung ohne mittelpunkte und Biegekanten, waär ich sehr dankbar 

bis dann 

------------------
Gruss Alexis

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

---

Hallo nochmal,

ja Alexis ich meld mich dann sofort. Bisher war ich recht glücklos.

Daher versuch ich es mal ein bisschen anders...

Also ich möchte hier kein Tool für umsonst  Ich bin selbstverständlich bereit einen Unkostenbeitrag für eine auto-dxf Erstellung zu bezahlen. Ausser es sind jetzt tausende von Euro. Gerne kann sich ein interessierter VBA-Kenner melden....

Gruss Headde

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

---

Hallo headde,

schreib das Makro doch mal in das Anwendungsprojekt. Geht es dann?

Gruß
Reinhard

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

---

Zitat:

---

Original erstellt von headde:
Eine ganz doofe Frage....was wird da jetzt genau als dxf rausgeschrieben? Alle Ansichten wenn ich mehrere auf meiner Zeichnung hab, oder nur die Ansicht der Abwicklung?

---

Hallo haedde,

check PM

------------------
Grüsse, Paul

Inventor-Programmierung, Inventor-Tools und Inventor API-Schulung

thinkCAD Web-Kataloge

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

---

Hallo Forumuser,

wie kann ich die Optionen für den DXF Export mit VBA einstellen, bzw. wie sage ich Inventor, das er eine bestimmte .ini Datei aufrufen soll um die optionen einzustellen?

Wie kann ich den Inhalt einer .txt Datei einlesen?

MfG
Thomas

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

---

Hallo Forumuser,

mein bisheriger Code sieht so aus

Code:

---

Public Sub SaveAsDxf()

    If ThisApplication.Documents.Count = 0 Then
        MsgBox "No Document open", 16, "Error"
        Exit Sub
    Exit Sub
    End If
   
    If Not ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
        MsgBox "No Drawing", 16, "Error"
        Exit Sub
    End If
   
Dim dDoc As DrawingDocument
Dim fso As Object
Set fso = CreateObject("Scripting.FilesystemObject")
Dim ret As Variant
Set dDoc = ThisApplication.ActiveDocument
Dim oProp As Inventor.Property
Set oProp = dDoc.PropertySets(4).Item("DOKUMENTENNUMMER")
If dDoc Is Nothing Then Exit Sub
If Len(Trim(dDoc.FullFileName)) > 0 Then
      outFile = "C:\Zeichnungen" & "\" & oProp.Value & ".dxf"
        dDoc.SaveAs outFile, True
Else
        MsgBox "Erst Speichern", vbInformation
End If
 
End Sub

---

hier hätte ich gerne noch die Konfigurationseinstellungen drin, die über die ini Datei gesteuert werden!

MfG
Thomas

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

---

Hallo Forumuser,

habe jetzt selbst eine Lösung gefunden! Und zwar hab ich 2 .ini Dateien angelegt und lasse diese beim Aufruf des Macros umbennenen und anschließend wieder zurück! Ist vielleicht ein wenig umständlich aber es funktioniert!
Die .ini Dateien habe ich von den Rechten noch so geändert, das diese nicht verändert bzw. gelöscht werden können!

Hier mein Code!!!

Code:

---

Public Sub SaveAsDxf()
    If ThisApplication.ActiveDocument Is Nothing Then
        MsgBox "No Document open", 16, "Error"
        Exit Sub
    End If
   
    If Not ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
        MsgBox "No Drawing", 16, "Error"
        Exit Sub
    End If

Dim AlterName, NeuerName
AlterName = Environ$("TEMP") & "\exportdxf100.ini": NeuerName = Environ$("TEMP") & "\exportdxf100_umbenannt.ini"
Name AlterName As NeuerName  ' Datei verschieben und umbenennen.
Dim AlterName2, NeuerName2
AlterName2 = Environ$("TEMP") & "\exportdxfprog.ini": NeuerName2 = Environ$("TEMP") & "\exportdxf100.ini"
Name AlterName2 As NeuerName2  ' Datei verschieben und umbenennen.

Dim dDoc As DrawingDocument
Dim fso As Object
Set fso = CreateObject("Scripting.FilesystemObject")
Dim ret As Variant
Set dDoc = ThisApplication.ActiveDocument
Dim oProp As Inventor.Property
On Error Resume Next
Set oProp = dDoc.PropertySets(4).Item("DOKUMENTENNUMMER")
If Err Then
    MsgBox "I-Property DOKUMENTENNUMMER existiert nicht", 16, "Error"
    GoTo Um2
End If
   
If oProp.Value Is Nothing Then
    MsgBox "Das I-Property DOKUMENTENNUMMER ist leer!", 16, "Error"
    GoTo Um2
End If

If Len(Trim(dDoc.FullFileName)) > 0 Then
      outFile = "C:\Zeichnungen" & "\" & oProp.Value & ".dxf"
      On Error Resume Next
        dDoc.SaveAs outFile, True
If Err Then
    MsgBox "Bitte erstellen Sie einen Ordner Zeichnungen unter C:\", 16, "Error"
    GoTo Um2
End If
Else
        MsgBox "Erst Speichern", vbInformation

End If

Um2:
Dim AlterName3, NeuerName3
AlterName3 = Environ$("TEMP") & "\exportdxf100.ini": NeuerName3 = Environ$("TEMP") & "\exportdxfprog.ini"
Name AlterName3 As NeuerName3  ' Datei verschieben und umbenennen.
Dim AlterName4, NeuerName4
AlterName4 = Environ$("TEMP") & "\exportdxf100_umbenannt.ini": NeuerName4 = Environ$("TEMP") & "\exportdxf100.ini"
Name AlterName4 As NeuerName4  ' Datei verschieben und umbenennen.

End Sub

---

MfG
Thomas

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

---

Mahlzeit und sorry das ich dieses Thema ausgegraben habe.
Ich weiß das der Beitrag schon sehr alt ist, doch würde es mich mich interessieren ob ich an diesem VBA-Code:

Sub SaveAsDxf()
Dim dDoc As DrawingDocument
Dim fso As Object
Set fso = CreateObject("Scripting.FilesystemObject")
Dim ret As Variant
Set dDoc = ThisApplication.ActiveDocument
If dDoc Is Nothing Then Exit Sub
If Len(Trim(dDoc.FullFileName)) > 0 Then
      outFile = fso.GetParentFolderName(dDoc.FullFileName) & "\" & fso.GetBaseName(dDoc.FullFileName) & ".dxf"
        dDoc.SaveAs outFile, True
Else
        MsgBox "Erst Speichern", vbInformation
End If
   
End Sub

ändern kann, damit er alle offenen Dokumente als DXF speichert.

MfG Chris

PS:
Bin ein ziemlicher VBA-Newbie. Tschuldigung für diese "für euch wohl einfache Frage" 

------------------
Rechtschreibfehler sind erwünscht und dienen der Unterhaltung des Lesers.  

[Diese Nachricht wurde von Kizz am 03. Jul. 2012 editiert.]

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

---

Hallo

Probier mal:

Code:

---

Sub SaveAsDxf()

Dim oDoc As Document
Dim dDoc As DrawingDocument
Dim fso As Object
Dim ret As Variant

For Each oDoc In ThisApplication.Documents

    If oDoc.DocumentType = kDrawingDocumentObject Then
        Set fso = CreateObject("Scripting.FilesystemObject")
        Call oDoc.Activate
        Set dDoc = ThisApplication.ActiveDocument
        If dDoc Is Nothing Then Exit Sub
            If Len(Trim(dDoc.FullFileName)) > 0 Then
                outFile = fso.GetParentFolderName(dDoc.FullFileName) & "\" & fso.GetBaseName(dDoc.FullFileName) & ".dxf"
                dDoc.SaveAs outFile, True
            Else
                MsgBox "Erst alles Speichern", vbInformation
                Exit Sub
            End If
        End If
    End If
Next

End Sub

---

------------------
MfG
Ralf

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

---

Hallo rkauskh
Es funktioniert, doch ich musste bevor es lief das letzte "End If" löschen. Warum weiß ich zwar nicht, doch es funktioniert.
Danke!

Wenn ich statt dxf sagen wir pdf machen möchte, brauch ich dann nur alle DXF-Angaben mit PDF austauschen?
Also so:
Sub SaveAsPdf()
Dim oDoc As Document
Dim dDoc As DrawingDocument
Dim fso As Object
Dim ret As Variant

For Each oDoc In ThisApplication.Documents

    If oDoc.DocumentType = kDrawingDocumentObject Then
        Set fso = CreateObject("Scripting.FilesystemObject")
        Call oDoc.Activate
        Set dDoc = ThisApplication.ActiveDocument
        If dDoc Is Nothing Then Exit Sub
            If Len(Trim(dDoc.FullFileName)) > 0 Then
                outFile = fso.GetParentFolderName(dDoc.FullFileName) & "\" & fso.GetBaseName(dDoc.FullFileName) & ".pdf"
                dDoc.SaveAs outFile, True
            Else
                MsgBox "Erst alles Speichern", vbInformation
                Exit Sub
            End If
        End If
Next

End Sub

MfG Chris

------------------
Rechtschreibfehler sind erwünscht und dienen der Unterhaltung des Lesers. 

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

---

Hallo

Das letzte End If mußte weg, weils zu viel war. Mein Fehler, die Zeile

Code:

---

If dDoc Is Nothing Then Exit Sub

---

benötigt kein abschließendes End If. Das ist eine Abkürzung, wenn nur eine Anweisung ausgeführt werden soll. Man könnte in dr Langversion schreiben:

Code:

---

If dDoc Is Nothing Then
  Exit Sub
End If

---

Mit der Endung PDF sollte gehen. Versuch macht kluch. 

------------------
MfG
Ralf

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

---

Jep. Funktioniert.

Ich glaube ich habe gerade den VBA Editor für mich entdeckt 

Vielen Dank!

MfG Chris

------------------
Rechtschreibfehler sind erwünscht und dienen der Unterhaltung des Lesers. 

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