Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Inventor VBA
  Unterordner im Projektverzeichniss erstellen

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
Autor Thema:  Unterordner im Projektverzeichniss erstellen (1969 mal gelesen)
Xaigon
Mitglied



Sehen Sie sich das Profil von Xaigon an!   Senden Sie eine Private Message an Xaigon  Schreiben Sie einen Gästebucheintrag für Xaigon

Beiträge: 15
Registriert: 16.08.2012

Autodesk Inventor 2014
Autodesk Vault Professional 2014

erstellt am: 16. Aug. 2012 09:22    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo zusammen,

bin neu im Forum und will ein Makro erstellen, dass im aktuellen Projektverzeichniss im Inventor (2012) als "PDF" - Ordner erstellt wird, anschliessend wird das PDF erzeugt und in diesem Ordner auch abgelegt. Den Code für die PDF erzeugung hab ich schon! Siehe unten, jedoch die Ordnererstellung im Projektverzeichniss und abfrage ob es diesen schon giebt krieg ich nicht auf die Reihe! Kann mir jeman helfen?

Code:
Public Sub PDF()

    Dim oDoc As DrawingDocument
        Dim Msg
            ' If an error occurs, construct an error message
            On Error Resume Next    ' Defer error handling.
            Err.Clear
            'Err.Raise 6    ' Generate an "Overflow" error.
            ' Check for error, then show message.
        If Err.Number <> 0 Then
            Msg = "KeineZeichnung "
            MsgBox Msg
            End If
           
    Set oDoc = ThisApplication.ActiveDocument
   
    oDoc.SheetSettings.SheetColor = ThisApplication.TransientObjects.CreateColor(255, 255, 255)
   
    ' Get the PDF translator Add-In.
    Dim PDFAddIn As TranslatorAddIn
    Set PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")

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

    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

    ' Create a DataMedium object
    Dim oDataMedium As DataMedium
    Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

    ' Check whether the translator has 'SaveCopyAs' options
    If PDFAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then

        ' Options for drawings...

        oOptions.Value("All_Color_AS_Black") = 0

        'oOptions.Value("Remove_Line_Weights") = 0
        'oOptions.Value("Vector_Resolution") = 400
        'oOptions.Value("Sheet_Range") = kPrintAllSheets
        'oOptions.Value("Custom_Begin_Sheet") = 2
        'oOptions.Value("Custom_End_Sheet") = 4

    End If

    'Set the destination file name
    'oDataMedium.FileName = "c:\temp\test.pdf"                <------
    ' erzeugt ein pdf mit gleichem Namen im gleiche Verzeichnis wie die *.idw
    oDataMedium.FileName = Replace(oDoc.FullDocumentName, ".idw", ".pdf")
   

    'Publish document.
    Call PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)

   
    Dim oFarbe As DrawingDocument
                   
    Set oFarbe = ThisApplication.ActiveDocument
    oFarbe.SheetSettings.SheetColor = ThisApplication.TransientObjects.CreateColor(255, 255, 255)
   
End Sub


 

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

noctis79
Mitglied
Konstrukteur/ CAD-Administrator


Sehen Sie sich das Profil von noctis79 an!   Senden Sie eine Private Message an noctis79  Schreiben Sie einen Gästebucheintrag für noctis79

Beiträge: 164
Registriert: 07.10.2009

Inventor Pro 2017
Cideon Workspace

erstellt am: 29. Aug. 2012 14:44    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Xaigon 10 Unities + Antwort hilfreich

Hallo Xaigon,

folgender Code legt Dir einen Ordner an, wenn dieser noch
nicht existiert:

Code:
  Dim oapp As Inventor.Application
  Set oapp = ThisApplication
  Dim opPath As String
  Set fs = CreateObject("Scripting.FileSystemObject")
  opPath = oapp.FileLocations.Workspace

    If Not fs.FolderExists(opPath & "\PDF") Then MkDir opPath & "\PDF"


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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz