---

Es ging eine Zeit lang ich weiß leider nicht was ich geändert habe aber beim Export wirft es mir ein Zip aus.
Wenn man das .zip auf macht liegt darin das .dwg und ein "Fonts" Ordner
In dem Fonts Ordner sind wiederum:
isocpeur.ttf
ltypeshp.shx
txt.shx

Warum macht es das?

Code:

---

Public Sub Dev_DWG()
    ' Get the DWG translator Add-In.
    Dim DWGAddIn As TranslatorAddIn
    Set DWGAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC2-122E-11D5-8E91-0010B541CD80}")

    'Set a reference to the active document (the document to be published).
    Dim oDocument As Document
    Set oDocument = ThisApplication.ActiveDocument

    Dim transObjs As TransientObjects
    Set transObjs = ThisApplication.TransientObjects
   
    Dim oContext As TranslationContext
    Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
    oContext.Type = kFileBrowseIOMechanism
   

    ' Create a NameValueMap object
    Dim oOptions As NameValueMap
    'Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
    Set oOptions = transObjs.CreateNameValueMap
    ' Create a DataMedium object
    Dim oDataMedium As dataMedium
    'Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium    '1 Version dwg inventor
    Set oDataMedium = transObjs.CreateDataMedium                            '2 Version dwg autocas 2000

    ' Check whether the translator has 'SaveCopyAs' options
    'If DWGAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
'
'        Dim strIniFile As String
'        strIniFile = "C:\tempDWGOut.ini"
'        ' Create the name-value that specifies the ini file to use.
'        oOptions.Value("Export_Acad_IniFile") = strIniFile
'    End If

                        Dim oDoc As Document
                        Dim Länge_Dateiname_mit_Pfad As Integer
                        Dim Name_Pfad As String
                        Dim Pfad_export As String
                        Dim Länge_String As Integer
                        Dim Dateiname_mit_Pfad As String
                        Set oDoc = ThisApplication.ActiveDocument
                       
                       
                            '____________________________________________________________________iProperties_______________________________________
                            ' Get the PropertySets object.
                            Dim oPropSets As PropertySets
                            Set oPropSets = oDoc.PropertySets
                       
                            ' Get the design tracking property set.
                            Dim oPropSet As PropertySet
                            Set oPropSet = oPropSets.item("Design Tracking Properties")
                       
                            ' Get the drawing number iProperty.
                            'Dim status As Property
                            'Set status = oPropSet.Item("User Status")
                           
                           
                            'Get the ipt status iProperty
                            Dim oDrawDoc As DrawingDocument
                            On Error Resume Next
                            Set oDrawDoc = ThisApplication.ActiveDocument
                            Dim oReferencedDoc As Document
                            Set oReferencedDoc = oDrawDoc.ReferencedDocuments.item(1)
                           
                            Dim oPropValue As String
                            oPropValue = oReferencedDoc.PropertySets.item("{32853F0F-3444-11D1-9E93-0060B03C1CA6}").item("User Status").Value
                       
                            ' Display the value.
                            'MsgBox "Status der Datei: " & oPropValue
                            '______________________________________________________________________iProperties__________________________________________
                       
                       
                        Dateiname_mit_Pfad = oDoc.FullFileName
                        'MsgBox "Name der Datei: " & Dateiname_mit_Pfad
                        If Dateiname_mit_Pfad = "" Then
                            MsgBox "Dokument nicht gespeichert!"
                            Exit Sub
                        End If
                        Länge_Dateiname_mit_Pfad = Len(Dateiname_mit_Pfad)
                        Dim Endung As Integer
                        'Endung = 0 'mit .ipt usw.
                        Endung = 4 ' ohne .ipt usw
                        Name_Pfad = Mid(Dateiname_mit_Pfad, 1, Länge_Dateiname_mit_Pfad - 4)
                        Länge_String = Len(Name_Pfad)
                       
                        Dim i As Integer
                        i = 1
                        Do Until Mid(Name_Pfad, Länge_String - i, 1) = "\"
                          i = i + 1
                        Loop
                       
                        Dateiname = Right(Name_Pfad, i)
                        Name_Pfad = Mid(Dateiname_mit_Pfad, 1, Länge_Dateiname_mit_Pfad - i)
                        'MsgBox "Dateiname : " & Dateiname & Chr(10) & "Pfad : " & Name_Pfad & Chr(10) & "Laufwerk: " & destination & Pfad_export

    '___________________________________________________DWG Form 2000/2004/...______________________________________________________________________
    ' Get the available options from the translator.
    'Dim options As NameValueMap
    'Set options = transObjs.CreateNameValueMap
    If DWGAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
        ' Set the options for what types of data to write out.
        oOptions.Value("Solid") = True      ' Output solids.
        oOptions.Value("Surface") = False  ' Output surfaces.
        oOptions.Value("Sketch") = False    ' Output sketches.
     
        ' Set the DWG version.
        ' 23 = ACAD 2000 - AC1015
        ' 25 = ACAD 2004 - AC1018
        ' 27 = ACAD 2007
        ' 29 = ACAD 2010 - AC1024
        oOptions.Value("DwgVersion") = 25
    End If
    '___________________________________________________DWG Form 2000/2004/...______________________________________________________________________

    'MsgBox Dateiname
    'TheFolder$ = BrowseForFolder("Wählen Sie einen Ordner aus.")
    TheFolder$ = GetFolder("Wählen Sie einen Ordner aus.", "\\SERVER\CAD")
    'Set the destination file name
    If oPropValue = "" Then
        oDataMedium.FileName = TheFolder$ & "\" & Dateiname & ".dwg"
    Else
        oDataMedium.FileName = TheFolder$ & "\" & Dateiname & "_" & oPropValue & ".dwg"
    End If
    'Set the destination file name
    'oDataMedium.FileName = "c:\tempdwgout.dwg"
    'Publish document.
    'MsgBox oDataMedium.FileName
    If Not TheFolder$ = "" Then
        Call DWGAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
        If UserForm1.alert.Value = True Then
            MsgBox "DWG Export abgeschlossen!", vbOKOnly, "DWG Erstellt!"
        End If
        If UserForm1.folder_open.Value = True Then
            Call open_folder(TheFolder$)
        End If
    Else
        MsgBox "Export abgebrochen, kein Verzeichnis gewählt!"
    End If
End Sub

---

------------------
Grüße aus Wien
Philipp

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

---

Speicher einmal manuell eine dwg (ohne Option PacknGo)

Gruß

------------------
Gruß
SEHER
www.inventor-tools.de

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

---

Ja mit kopie speichern unter geht es ja da kommt ein dwg raus.
Aber mit dem Makro nicht mehr

------------------
Grüße aus Wien
Philipp

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

---

Hallo axi92

kann es sei dass Du beim erstellen der DWGOut.ini bei den Optionen
den Haken bei Pack and Go stehen hast.
Erstell Dir mal mit Kope speichern eine neue Ini-Datei und acht mal auf
die Optionen.

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

---

Hallo

der Seher meint damit das bei einem händisch durchgeführten DWG-Export ohne den Haken bei Pack'nGo die Einstellung gespeichert und später auch von deinem Makro so verwendet wird.
Du kannst aber auch mal testen

Code:

---

oOptions.Value("Use_Transmittal")=No

---

zu setzen.

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

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

---

Ini.JPG

Habe  den Anhang vergessen

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

---

Hat anscheinend damit funktioniert danke für den Code 

------------------
Grüße aus Wien
Philipp

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

---

Hallo

Wenn du keine ini-Datei mitgibst, solltest du weitere Einstellungen im Code vorgeben. Am besten stellst du über die GUI mal alles so ein wie's sein soll und speicherst die Konfiguration als ini-Datei ab. Anschließend öffnest du die Datei mit einem Texteditor und wenn du die Use Transmittal Zeile mit meiner Codezeile von oben vergleichst, erklärt sich die Umsetzung der anderen Optionen eigentlich selbst.

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

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

---

Ok ich habe ja das

Code:

---

        oOptions.Value("Use_Transmittal") = No

---

drinnen, jedoch hat mir IV schon wieder eine .zip Datei erzeugt.
Außerdem finde ich die Exporteinstellungen von der .dwg nicht mehr^^

------------------
Grüße aus Wien
Philipp

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

---

Ok die Einstellungen habe ich wieder gefunden, war nur auf der falschen .idw (IV) xD
Ich habe mir jetzt die .ini gespeichert
Dort heißt der Eintrag:

Code:

---

USE TRANSMITTAL=No

---

Wobei ich nebenbei auch noch das http://adndevblog.typepad.com/manufacturing/2012/05/the-setting-use-transmittalno-has-no-effect-in-the-ini-file-when-exporting-to-dwg.html#tpe-action-posted-6a0167607c2431970b019b0 0f892f1970b gefunden habe.
Kann es sein das man in VBA statt dem hier was ich bis jetzt noch habe:

Code:

---

oOptions.Value("Use_Transmittal") = No

---

das hier benötigt?

Code:

---

oOptions.Value("USE TRANSMITTAL") = No

---

Oder kennt sich da niemand aus auf dem Gebiet?

------------------
Grüße aus Wien
Philipp

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