Esportazione "automatica" idw to pdf-dxf

Esselle

Utente Standard
Professione: Tiro linee
Software: Inventor, Autocad e occasionalmente Solidworks 2016
Regione: Italia
#41
Mi pare funzioni

Codice:
    ' Obtain reference to drawing
    Dim oDoc As Document
    Set oDoc = ThisApplication.ActiveDocument
    
    If oDoc.DocumentType <> kDrawingDocumentObject Then
        MsgBox ("Deve essere aperta una tavola")
        Exit Sub
    End If
    
    ' Save the file with dependants
    oDoc.Save2
    
    Dim fn As String
    Dim DWGfn As String
    Dim PDFfn As String
    
    ' Generate the file names
    fn = oDoc.FullFileName
    DWGfn = Strings.Left(fn, Len(fn) - 4) & ".dwg"
    PDFfn = Strings.Left(fn, Len(fn) - 4) & ".pdf"
    
    
    ' Get the DWG translator Add-In.
    Dim DWGAddIn As TranslatorAddIn
    Set DWGAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC2-122E-11D5-8E91-0010B541CD80}")

    ' Get the DXF translator Add-In.
    Dim DXFAddIn As TranslatorAddIn
    Set DXFAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}")
    
    ' Get the PDF translator Add-In.
    Dim PDFAddIn As TranslatorAddIn
    Set PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
    
    Dim strIniFile As String
    
    
    ' Common init
    ' Create a Context object
    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

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

    'Set the destination file name
    oDataMedium.filename = DWGfn


    'Publish document.
    Call DWGAddIn.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)
    
    ' -------------------------------
    ' FINE DWG
    ' ---------------------------------------------------------------------------
  
    
    ' ---------------------------------------------------------------------------
    ' PDF
    ' -------------------------------

    ' Check whether the translator has 'SaveCopyAs' options
    If PDFAddIn.HasSaveCopyAsOptions(oDoc, 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 = PDFfn


    'Publish document.
    Call PDFAddIn.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)
    ' -------------------------------
    ' FINE PDF
    ' ---------------------------------------------------------------------------
End Sub
Grazie mille! Domani la provo e ti dico! Gentilissimo.
 

Esselle

Utente Standard
Professione: Tiro linee
Software: Inventor, Autocad e occasionalmente Solidworks 2016
Regione: Italia
#42
L'ultima macro postata non riesco a farla funzionare, non sono riuscito a capire il motivo. Sul modulo 1 ho già caricata la macro precedente, ho provato ad incollare il testo postato sotto la macro e non mi funziona, nel senso che non compaiono altre diciture nella finestra dei pulsanti programmabili da macro. Ho provato a togliere la macro esistente e fare la stessa procedura, ma con lo stesso infelice risultato...dove sbaglio?

Poi ho dato un'occhiata alla soluzione alternativa e in effetti è molto semplice da implementare, però anche qui forse sbaglio qualcosa, infatti crea il pdf e dwg solo al primo salvataggio nei successivi salvataggi non sovrascrive i file creati precedentemente.

Scusate l'imbranataggine...:confused:
 

Catafratto

Utente Standard
Professione: Disegnatore/progettista
Software: Inventor 2016
Regione: Veneto
#43
L'ultima macro postata non riesco a farla funzionare, non sono riuscito a capire il motivo. Sul modulo 1 ho già caricata la macro precedente, ho provato ad incollare il testo postato sotto la macro e non mi funziona, nel senso che non compaiono altre diciture nella finestra dei pulsanti programmabili da macro. Ho provato a togliere la macro esistente e fare la stessa procedura, ma con lo stesso infelice risultato...dove sbaglio?
...
Non sbagli, sono io sbadato e ho perso l'inizio della macro nel copia/incolla :redface:

- - - Aggiornato - - -

... e premo invia risposta prima di aver finito la risposta :redface::redface:
Codice:
Public sub SAVE_IDWGWGPDF
    
    ' Obtain reference to drawing
    Dim oDoc As Document
    Set oDoc = ThisApplication.ActiveDocument
    
    If oDoc.DocumentType <> kDrawingDocumentObject Then
        MsgBox ("Deve essere aperta una tavola")
        Exit Sub
    End If
    
    ' Save the file with dependants
    oDoc.Save2
    
    Dim fn As String
    Dim DWGfn As String
    Dim PDFfn As String
    
    ' Generate the file names
    fn = oDoc.FullFileName
    DWGfn = Strings.Left(fn, Len(fn) - 4) & ".dwg"
    PDFfn = Strings.Left(fn, Len(fn) - 4) & ".pdf"
    
    
    ' Get the DWG translator Add-In.
    Dim DWGAddIn As TranslatorAddIn
    Set DWGAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC2-122E-11D5-8E91-0010B541CD80}")

    ' Get the DXF translator Add-In.
    Dim DXFAddIn As TranslatorAddIn
    Set DXFAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}")
    
    ' Get the PDF translator Add-In.
    Dim PDFAddIn As TranslatorAddIn
    Set PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
    
    Dim strIniFile As String
    
    
    ' Common init
    ' Create a Context object
    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

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

    'Set the destination file name
    oDataMedium.filename = DWGfn


    'Publish document.
    Call DWGAddIn.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)
    
    ' -------------------------------
    ' FINE DWG
    ' ---------------------------------------------------------------------------
  
    
    ' ---------------------------------------------------------------------------
    ' PDF
    ' -------------------------------

    ' Check whether the translator has 'SaveCopyAs' options
    If PDFAddIn.HasSaveCopyAsOptions(oDoc, 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 = PDFfn


    'Publish document.
    Call PDFAddIn.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)
    ' -------------------------------
    ' FINE PDF
    ' ---------------------------------------------------------------------------
End Sub
... Stranissimo, la prima riga della macro non si copia/incolla... ho dovuto scriverla a mano. BOH!
Comunque a me sovrascrive se non lo fa... non saprei perchè!

Sovrascrivi la vecchia macro
 

Esselle

Utente Standard
Professione: Tiro linee
Software: Inventor, Autocad e occasionalmente Solidworks 2016
Regione: Italia
#44
Grazie, ora provo, ma devo togliere quella esistente? La incollo sotto?
 

MauroM

Utente Standard
Professione: mah!
Software: Inv + SW(purtroppo)
Regione: .
#47
Salve a tutti, è da un pezzo che avevo una domanda :
i tasti collegati alle macro, mi appaiono tutti con la stessa icona
Cattura.JPG

c'è modo di cambiarle ?
grazie.
 

callaghan

Utente Junior
Professione: disegnatore
Software: Inventor 2014
Regione: Piemonte (TO)
#50
scusate, ma alla fine qualcuno è riuscito ad esportare in pdf un'intera cartella di idw già esistenti??
 

Catafratto

Utente Standard
Professione: Disegnatore/progettista
Software: Inventor 2016
Regione: Veneto
#51
scusate, ma alla fine qualcuno è riuscito ad esportare in pdf un'intera cartella di idw già esistenti??
Prova questo: ti compare una riga di input, inserisci il percorso della cartella dove vuoi fare il lavoro, apre ed esporta tutti gli idw che contiene: poichè ho buttato giù le cose in fretta fatti delle prove su cartelle copiate, prima, che non si sa mai :biggrin:! Le numerose (= 1) prove che ho fatto funzionavano. NON aggiungere il backSlash a fine percorso al momento dell'input sennò non va.

La macro da lanciare è DirIDW

Fammi sapere


Codice:
Public Sub DirIDW()

    Dim myDir As String
    Dim myName As String
    
    ' Richiede il percorso della cartella
    myDir = InputBox("Inserisci il percorso dei disegni (termina SENZA \)", "Richiesta percorso files")
    

    ' Visualizza i nomi in c:\ che rappresentano directory.
    myName = Dir(myDir & "\*.idw", vbNormal)   ' Recupera la prima voce.
    Debug.Print "Inizio ciclo"
    Dim i As Integer
    Do While myName <> ""    ' Avvia il ciclo.
        Debug.Print i, myDir & "\" & myName
        ExportDirToDWG_PDF (myDir & "\" & myName)
        myName = Dir    ' Legge la voce successiva.
        i = i + 1
    Loop

End Sub


Public Sub ExportDirToDWG_PDF(drawing As String)
    
    ' Obtain reference to drawing
    Dim oDoc As Document
    Set oDoc = ThisApplication.Documents.Open(drawing)
    
    
    Dim fn As String
    Dim DWGfn As String
    Dim PDFfn As String
    
    ' Generate the file names
    fn = oDoc.FullFileName
    DWGfn = Strings.Left(fn, Len(fn) - 4) & ".dwg"
    PDFfn = Strings.Left(fn, Len(fn) - 4) & ".pdf"
    
    
    ' Get the DWG translator Add-In.
    Dim DWGAddIn As TranslatorAddIn
    Set DWGAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC2-122E-11D5-8E91-0010B541CD80}")

    ' Get the DXF translator Add-In.
    Dim DXFAddIn As TranslatorAddIn
    Set DXFAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}")
    
    ' Get the PDF translator Add-In.
    Dim PDFAddIn As TranslatorAddIn
    Set PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
    
    Dim strIniFile As String
    
    
    ' Common init
    ' Create a Context object
    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

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

    'Set the destination file name
    oDataMedium.filename = DWGfn


    'Publish document.
    Call DWGAddIn.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)
    
    ' -------------------------------
    ' FINE DWG
    ' ---------------------------------------------------------------------------
  
    
    ' ---------------------------------------------------------------------------
    ' PDF
    ' -------------------------------

    ' Check whether the translator has 'SaveCopyAs' options
    If PDFAddIn.HasSaveCopyAsOptions(oDoc, 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 = PDFfn


    'Publish document.
    Call PDFAddIn.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)
    ' -------------------------------
    ' FINE PDF
    ' ---------------------------------------------------------------------------
    
    oDoc.Close (True)
End Sub
 

MauroM

Utente Standard
Professione: mah!
Software: Inv + SW(purtroppo)
Regione: .
#52
Provato e funziona.
Però se cerco di salvare il default.ivb ( nel quale avevo incollato il dirIDW ) mi dice :

msg.JPG

che può essere ?

Mille grazie.
 

Catafratto

Utente Standard
Professione: Disegnatore/progettista
Software: Inventor 2016
Regione: Veneto
#53
Provato e funziona.
Però se cerco di salvare il default.ivb ( nel quale avevo incollato il dirIDW ) mi dice :

View attachment 39358

che può essere ?

Mille grazie.
Non ho idea... sparo a caso:
siete in più persone in ufficio e condividete il file default.ivb? Solo il primo ad aver aperto una sessione di Inventor può salvarlo
Hai usato l'editor VBA di Inventor per fare la cosa?
Ci sono password/diritti di amministratore/ecc sul disco dove lavori?
Ti dà lo stesso errore anche se provi a scrivere qualcosa e salvare, tipo
"Public sub Pippo()
End sub"

E soprattutto, hai riavviato il computer e riprovato?
 

callaghan

Utente Junior
Professione: disegnatore
Software: Inventor 2014
Regione: Piemonte (TO)
#56
Purtroppo non va...:confused:
Al primo avvio della macro converte tutti gli .idw in .dwg e tutti gli .idw in .pdf tranne 2
al secondo tentativo i .dwg sempre OK e i .pdf tutti tranne 4
al terzo tentativo i .dwg sempre OK e i .pdf tutti tranne 6
e così via..
sembra che ci sia qualche contatore che ad ogni lancio della macro tolga 2 file da convertire
da notare che gli .idw si aprono automaicamente tutti durante la macro, ma alcuni non vengono convertiti in .pdf
boh???
purtroppo non capisco una mazza di VB.. vedo se qualche collega...
 

Catafratto

Utente Standard
Professione: Disegnatore/progettista
Software: Inventor 2016
Regione: Veneto
#57
Purtroppo non va...:confused:
Al primo avvio della macro converte tutti gli .idw in .dwg e tutti gli .idw in .pdf tranne 2
al secondo tentativo i .dwg sempre OK e i .pdf tutti tranne 4
al terzo tentativo i .dwg sempre OK e i .pdf tutti tranne 6
e così via..
sembra che ci sia qualche contatore che ad ogni lancio della macro tolga 2 file da convertire
da notare che gli .idw si aprono automaicamente tutti durante la macro, ma alcuni non vengono convertiti in .pdf
boh???
purtroppo non capisco una mazza di VB.. vedo se qualche collega...

- Hai provato ad aprire i disegni che danno problemi e ad usare la versione "manuale" della macro per vedere che succede? Non mi viene in mente proprio niente...
- Qualcun altro ha provato e ha avuto problemi simili?

- Hai riavviato tutto? E' un toccasana collaudato, vale sempre la pena provare :biggrin:
 

callaghan

Utente Junior
Professione: disegnatore
Software: Inventor 2014
Regione: Piemonte (TO)
#59
devo ancora provare a riavviare il PC, Inventor ovviamente l'ho riavviato più volte
il fatto strano è che al primo giro va bene e converte tutti gli .idw, poi ogni volta che riprovi si perde i primi 2 files della lista
esempio: 21 files ok al primo giro, poi 19, 17, 15, 13.......
se riprovo su un'altra cartella riparte bene, poi di nuovo lo stesso errore
E' vero che mi basterebbe che funzionasse bene la prima volta x convertire in blocco tutti i disegni, poi eventuali modifiche/aggiunte dovrei gestirle singolarmente.
Proverò ancora, grazie comunque
 

callaghan

Utente Junior
Professione: disegnatore
Software: Inventor 2014
Regione: Piemonte (TO)
#60
Ho provato a riavviare il PC... Miracolo!! Funziona!! (x adesso.... :rolleyes: )
Ho anche suddiviso la macro: una x i pdf e una x i dwg

Grazie mille !! :finger: