Pagina 3 di 8 PrimaPrima 12345 ... UltimaUltima
Risultati da 21 a 30 di 73
  1. #21
    Utente Standard L'avatar di Catafratto
    Iscritto dal
    2011
    Messaggi
    809
    Professione
    Disegnatore/progettista
    Regione
    Veneto
    Software
    Inventor 2016

    Predefinito

    Secondo me hai copiato la funzione IsolaNome prima della riga contenete "End Sub": la funzione deve essere copiata alla fine di tutto, fuori dal blocco "sub - end sub". Comunque ti riposto tutto:

    Codice:
    Public Sub PubblicaDXFDWGPDF()
        
        ' Obtain reference to drawing
        Dim oDoc As Document
        Set oDoc = ThisApplication.ActiveDocument
        
        
        ' DESTINATION FOLDER
        ' ---------------------------------------------------
        Dim sExportPath As String
        sExportPath = "C:\Users\Utente\Desktop\DWG-DXF-PDF\"
        ' ---------------------------------------------------
        
        If oDoc.DocumentType <> kDrawingDocumentObject Then
            MsgBox ("Deve essere aperta una tavola")
            Exit Sub
        End If
        
        ' Get the filename with no path
        Dim sFileName As String
        sFileName = sExportPath & IsolaNome(oDoc.FullFileName, True)
        
        ' 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 = sFileName & ".dwg"
    
    
        'Publish document.
        Call DWGAddIn.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)
        
        ' -------------------------------
        ' FINE DWG
        ' ---------------------------------------------------------------------------
        
        
        ' ---------------------------------------------------------------------------
        ' DXF
        ' -------------------------------
        
        ' Check whether the translator has 'SaveCopyAs' options
        If DXFAddIn.HasSaveCopyAsOptions(oDoc, oContext, oOptions) Then
        
            ' File with exportation options
            strIniFile = "C:\tempDXFOut.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 = sFileName & ".dxf"
    
        'Publish document.
        Call DXFAddIn.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)
        ' -------------------------------
        ' FINE DXF
        ' ---------------------------------------------------------------------------
        
        
        ' ---------------------------------------------------------------------------
        ' 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 = sFileName & ".pdf"
    
    
        'Publish document.
        Call PDFAddIn.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)
        ' -------------------------------
        ' FINE PDF
        ' ---------------------------------------------------------------------------
    End Sub
    
    'Funzione che restituisce il nome del file togliendo il path ed il suffisso
    Public Function IsolaNome(ByVal NomeFile As String, Optional Trunc As Boolean) As String
        
        'toglie il .ipt
        If Trunc = True Then
            NomeFile = Strings.Left(NomeFile, Len(NomeFile) - 4)
        End If
        
        Dim pos As Integer
        'Ciclo che rimuove il path: trova "\" e tiene tutto a dx
        Do
            pos = InStr(NomeFile, "\")
            NomeFile = Strings.Right(NomeFile, Len(NomeFile) - pos)
        Loop Until pos = 0
        IsolaNome = NomeFile
    End Function
    Fammi sapere!
    Spesso astuzia ed intelligenza sono molto più efficaci dell'ottusa forza bruta: ma non ho proprio tempo di cercare qualcun alltro...

  2. #22
    Utente Junior
    Iscritto dal
    2012
    Messaggi
    13
    Professione
    Progettista
    Regione
    Lombardia
    Software
    Inventor / AutoCad

    Predefinito

    Citazione Originariamente Scritto da Catafratto Visualizza Messaggio
    ... quello che hanno fatto è stato togliere l'esecuzione automatica legata agli eventi (es. all'apertura, alla chiusura, ecc.)...
    Ciao, era proprio questo che volevo dire...

    Far girare la macro a livello applicazione, per me, significa non immettere il codice in un .idw, ma caricarlo in memoria all'apertura di inventor,
    (usando il default.ivb per intenderci) e far eseguire la macro VBA all'evento di chiusura/salvataggio del documento, dichiarando le variabili globali.
    Ho provato anche con regole e trigger esterni, ma niente da fare, le mie risorse intellettive non me lo hanno permesso :)

    Ho provato a fare il tasto, con il codice associato e funziona, ma è praticamente la stessa cosa che si ottiene con l'esporta pdf del menu,
    a me servirebbe una soluzione "silente", dove se uno non si ricorda di esportare il .pdf, lo fa' in automatico, per evitare discrepanze idw-pdf.

    Grazie comunque e buon lavoro.

  3. #23
    Utente Junior
    Iscritto dal
    2009
    Messaggi
    23
    Professione
    Progettista
    Regione
    Lombardia
    Software
    Inventor 2013

    Predefinito

    Opss! Perfetto ora funziona tutto!!! GRAZIE MILLEEE!

  4. #24
    Utente Junior
    Iscritto dal
    2009
    Messaggi
    23
    Professione
    Progettista
    Regione
    Lombardia
    Software
    Inventor 2013

    Predefinito

    ...Altra richiesta... Ne approfitto ma non so se è un operazione troppo onerosa in termini di tempo. La propongo:
    I miei file hanno nomenclatura nome.idw e i file esportati devono avere questa: nome (Rev.01) PN123456.pdf dove 01 identifica la revisione e 123456 il codice di ricambio che inserisco manualmente.
    Richiedo se sarebbe possibile inserire nel codice sopra un comando con il quale, una volta lanciata la macro, esca una finestra con il campo Rev.? e il campo PN? nei quali inserirò 01 e 123456 in modo tale che poi i file creati abbiano la nomenclatura automatizzata nome (Rev.01) PN123456.pdf/dxf

    Chiedo troppo? :)

  5. #25
    Utente Standard L'avatar di Catafratto
    Iscritto dal
    2011
    Messaggi
    809
    Professione
    Disegnatore/progettista
    Regione
    Veneto
    Software
    Inventor 2016

    Predefinito

    No, è roba da poco: al primo momento di fiacca nella giornata te lo faccio. Sono forse dati che hai nelle iProperties del modello?
    Spesso astuzia ed intelligenza sono molto più efficaci dell'ottusa forza bruta: ma non ho proprio tempo di cercare qualcun alltro...

  6. #26
    Utente Junior
    Iscritto dal
    2009
    Messaggi
    23
    Professione
    Progettista
    Regione
    Lombardia
    Software
    Inventor 2013

    Predefinito

    Si solo il codice PN come proprietà personalizzata P/N che compilo manualmente sia nell'IPT che nell'IDW.

  7. #27
    Utente Junior
    Iscritto dal
    2009
    Messaggi
    23
    Professione
    Progettista
    Regione
    Lombardia
    Software
    Inventor 2013

    Predefinito

    Citazione Originariamente Scritto da lollo76 Visualizza Messaggio
    ...Altra richiesta... Ne approfitto ma non so se è un operazione troppo onerosa in termini di tempo. La propongo:
    I miei file hanno nomenclatura nome.idw e i file esportati devono avere questa: nome (Rev.01) PN123456.pdf dove 01 identifica la revisione e 123456 il codice di ricambio che inserisco manualmente.
    Richiedo se sarebbe possibile inserire nel codice sopra un comando con il quale, una volta lanciata la macro, esca una finestra con il campo Rev.? e il campo PN? nei quali inserirò 01 e 123456 in modo tale che poi i file creati abbiano la nomenclatura automatizzata nome (Rev.01) PN123456.pdf/dxf

    Chiedo troppo? :)
    OPS mi sono accorto di un errore. La nomenclatura corretta è nome Rev.01 (PN123456).pdf/dxf

  8. #28
    Utente Standard L'avatar di Catafratto
    Iscritto dal
    2011
    Messaggi
    809
    Professione
    Disegnatore/progettista
    Regione
    Veneto
    Software
    Inventor 2016

    Predefinito

    Prova questo (sovrascrivi tutta la roba "vecchia"):
    Prima di chederti il codice la macro cerca di leggere la iPropertiy nella tavola. Se non c'è ti chiede il codice.
    Dorai aggiornare la macro con il nome della tua iProperty


    Codice:
    Public Sub PubblicaDXFDWGPDF()
        
        ' Obtain reference to drawing
        Dim oDoc As Document
        Set oDoc = ThisApplication.ActiveDocument
        
        
        ' DESTINATION FOLDER
        ' ---------------------------------------------------
        Dim sExportPath As String
        sExportPath = "C:\Users\Utente\Desktop\DWG-DXF-PDF\"
        ' ---------------------------------------------------
        
        If oDoc.DocumentType <> kDrawingDocumentObject Then
            MsgBox ("Deve essere aperta una tavola")
            Exit Sub
        End If
        
        ' Get the filename with no path
        Dim sFileName As String
        sFileName = sExportPath & IsolaNome(oDoc.FullFileName, True)
        
        ' Numero di revisione
        Dim sRev As String
        sRev = InputBox("Revisione:? ", "Inserimento numero di revisione", "00")
        
        'Legge le iProperties personalizzate:
        '-------------------------------------------------------------------------------------------------------
        Dim oPropSets As PropertySets
        Set oPropSets = oDoc.PropertySets
        
        'Custom
        '-------------------------------------------------------------------------------------------------------
        Dim oCustomPropSet As PropertySet
        Set oCustomPropSet = oPropSets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
    
        On Error Resume Next
        Dim sCod As String
    
        ' SOSTITUIRE "CODICE" CON IL NOME CHE SI USA PER L'IPROPERTY CHE INTERESSA
        sCod = oCustomPropSet.Item("Codice").Value
        
        If sCod = "" Then
            sCod = InputBox("Codice ricambio (Inserimento manuale):? ", "Inserimento manuale Codice ricambio")
        End If
        
        sFileName = sFileName & " Rev." & sRev & " (" & sCod & ")"
        
        ' 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 = sFileName & ".dwg"
    
    
        'Publish document.
        Call DWGAddIn.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)
        
        ' -------------------------------
        ' FINE DWG
        ' ---------------------------------------------------------------------------
        
        
        ' ---------------------------------------------------------------------------
        ' DXF
        ' -------------------------------
        
        ' Check whether the translator has 'SaveCopyAs' options
        If DXFAddIn.HasSaveCopyAsOptions(oDoc, oContext, oOptions) Then
        
            ' File with exportation options
            strIniFile = "C:\tempDXFOut.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 = sFileName & ".dxf"
    
        'Publish document.
        Call DXFAddIn.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)
        ' -------------------------------
        ' FINE DXF
        ' ---------------------------------------------------------------------------
        
        
        ' ---------------------------------------------------------------------------
        ' 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 = sFileName & ".pdf"
    
    
        'Publish document.
        Call PDFAddIn.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)
        ' -------------------------------
        ' FINE PDF
        ' ---------------------------------------------------------------------------
    End Sub
    
    'Funzione che restituisce il nome del file togliendo il path ed il suffisso
    Public Function IsolaNome(ByVal NomeFile As String, Optional Trunc As Boolean) As String
        
        'toglie il .ipt
        If Trunc = True Then
            NomeFile = Strings.Left(NomeFile, Len(NomeFile) - 4)
        End If
        
        Dim pos As Integer
        'Ciclo che rimuove il path: trova "\" e tiene tutto a dx
        Do
            pos = InStr(NomeFile, "\")
            NomeFile = Strings.Right(NomeFile, Len(NomeFile) - pos)
        Loop Until pos = 0
        IsolaNome = NomeFile
    End Function
    Spesso astuzia ed intelligenza sono molto più efficaci dell'ottusa forza bruta: ma non ho proprio tempo di cercare qualcun alltro...

  9. #29
    Utente Junior
    Iscritto dal
    2009
    Messaggi
    23
    Professione
    Progettista
    Regione
    Lombardia
    Software
    Inventor 2013

    Predefinito

    S T R E P I T O S O !!! Grazie mille!!! Funziona tutto perfettamente.

  10. #30
    Utente Standard
    Iscritto dal
    2007
    Messaggi
    380
    Professione
    Tiro linee
    Regione
    Italia
    Software
    Inventor, Autocad e occasionalmente Solidworks 2016

    Predefinito

    Mi intrufolo per una richiesta : se volessi salvare solo in dwg e pdf e nella stessa cartella dove sta il file idw che modifiche devo apportare alla macro? Ho provato, ma non capendoci nulla ho fatto dei tentativi infruttuosi . Premetto che già adesso uso una macro (trovata sempre tra queste pagine) per salvare nei due formati, ma attivata da pulsante personalizzato sulla barra strumenti.

    Grazie in anticipo!


  • Pagina 3 di 8 PrimaPrima 12345 ... UltimaUltima

    Discussioni Simili

    1. Esportazione Modello FEM da CATIA a ".nas"
      Di SeM_Mario nel forum CAE/FEM/CFD forum generale
      Risposte: 0
      Ultimo Messaggio: 05-09-2014, 15: 32
    2. Risposte: 0
      Ultimo Messaggio: 17-04-2014, 02: 38
    3. Risposte: 7
      Ultimo Messaggio: 27-03-2013, 14: 32
    4. Risposte: 7
      Ultimo Messaggio: 28-02-2013, 00: 55
    5. quotatura "automatica"
      Di spider916 nel forum CATIA V5 CATDrawing
      Risposte: 6
      Ultimo Messaggio: 23-05-2011, 10: 01

    Segnalibri

    Segnalibri

    Permessi di Scrittura

    • Tu non puoi inviare nuove discussioni
    • Tu non puoi inviare risposte
    • Tu non puoi inviare allegati
    • Tu non puoi modificare i tuoi messaggi
    •  





    CAD3D.it - la community dei progettisti