Copiare tutti i Fogli di un Disegno in un nuovo Disegno

Adahm

Utente standard
Professione: Consulente di Processo
Software: CatiaV5 / Inventor21
Regione: Lombardia
Ciao a tutti,

ho in archivio qualche migliaio di file di grosse dimensioni, perché sono stati generati da un Template "corrotto" e avrei la necessità di sistemarli.
Ho visto che copiando tutti i fogli di un file corrotto, in un file nuovo partendo da un Template "pulito", quest'ultimo ha delle dimensioni accettabili (meno di 1MB contro i 10MB del file corrotto).

Per questo motivo ho provato a scrivere una routine che possa fare questa operazione automaticamente, ma non riesco a farla funzionare. Per un po' sono riuscito a copiare i Fogli nel nuovo file, ma adesso non funziona più e non capisco in cosa sbaglio.

Qualcuno sa dirmi dove sbaglio o se il problema si può risolvere in altro modo?
Grazie

Di seguito il codice che sto cercando di far funzionare:

Codice:
Public Sub ReducingFileSize()
    ' Riduce le dimensioni dei file corrotti, copiandone i fogli in un file nuovo che sovrascriverà i file corrotti
   
    On Error GoTo Err_ReducingFileSize:
   
    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument
   
    ' Se non è un file di tipo drawing esce
    If oDrawDoc.DocumentType <> kDrawingDocumentObject Then
        MsgBox "Il documento attivo non è un disegno", vbCritical, "Documento non compatibile"
        Exit Sub
    End If
   
    ' Apre un file nuovo
    Dim sStandard As String
    sStandard = "\\ap03\PrismaTech\ConfigurazioniCAD\Inventor\Templates\Standard.idw"
    Dim oNewDrawDoc As DrawingDocument
    Set oNewDrawDoc = ThisApplication.Documents.Add(kDrawingDocumentObject, sStandard, True)  ', [CreateVisible] As Boolean )
   
    ' Cicla su ogni foglio del file e li copia nel file nuovo
    Dim oSheet As sheet
    For Each oSheet In oDrawDoc.Sheets
        Call oSheet.Activate
        ' Da questa riga non riesco a farlo funzionare, il resto del codice non è testato
        Call oSheet.CopyTo(oNewDrawDoc)
    Next
   
    ' Registra il percorso e il nome del file originale
    Dim sFullFileName As String
    sFullFileName = oDrawDoc.fullFilename
   
    ' Cancella il primo Foglio
    For Each oSheet In oNewDrawDoc.Sheets
        Call oSheet.Delete
        Exit For
    Next
   
    ' Aggiorna il documento
    Call oNewDrawDoc.Update
   
    ' Chiude il file originale
    Call oDrawDoc.Close(False)
   
    ' Salva il nuovo documento sovrascrivendo il file originale
    Call oNewDrawDoc.SaveAs(sFullFileName, False)
   
Err_ReducingFileSize:
    Debug.Print Err.Description
    Resume Next
End Sub
 

Matteo Cappelli dis.CAD

Utente Standard
Professione: disegnatore
Software: Inventor / autocad
Regione: Emilia romagna
ciao
hai provato con 1651057015606.png
permette di sostituire in massa all'interno degli idw presenti in una cartella le Risorse di disegno (cartigli squadrature ecc.) copiandole da un templete "corretto"
Se i dati hanno lo stesso nome , sostituisce il contenuto nel file "errato"
non so se ti può essere utile nel tuo caso
 

Adahm

Utente standard
Professione: Consulente di Processo
Software: CatiaV5 / Inventor21
Regione: Lombardia
Ciao Matteo,
cartigli, squadrature, ecc... sono corretti, è il file ad essere corrotto.
L'unico modo che ho trovato per sistemare il tutto, è stato quello di copiare i Fogli in un file nuovo, perciò il codice.
 

Catafratto

Utente Standard
Professione: Disegnatore/progettista
Software: Inventor 2020
Regione: Veneto
A dirti il vero mi pare funzioni benissimo (grazie per il codice, a questo punto!)

Ho fatto un paio di ritocchi per seguire meglio il funzionamento, ma appunto funziona

Le mie modifiche per provare:
- ho aggiunto un paio di MsgBox per vedere a che punto si blocca;
- Invece del ciclo for per eliminare il primo foglio sono andato con accesso diretto;
- ho modificato il nome del file di destinazione per non pasticciare con i nomi che poi non mi capivo più.

Che errore ti da?

Codice:
Public Sub ReducingFileSize()
    ' Riduce le dimensioni dei file corrotti, copiandone i fogli in un file nuovo che sovrascriverà i file corrotti
   
    On Error GoTo Err_ReducingFileSize:
   
    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument
   
    ' Se non è un file di tipo drawing esce
    If oDrawDoc.DocumentType <> kDrawingDocumentObject Then
        MsgBox "Il documento attivo non è un disegno", vbCritical, "Documento non compatibile"
        Exit Sub
    End If
   
    ' Apre un file nuovo
    Dim sStandard As String
    sStandard = "\\ap03\PrismaTech\ConfigurazioniCAD\Inventor\Templates\Standard.idw"
    Dim oNewDrawDoc As DrawingDocument
    Set oNewDrawDoc = ThisApplication.Documents.Add(kDrawingDocumentObject, sStandard, True)  ', [CreateVisible] As Boolean )
    MsgBox "nuova tavola"
    ' Cicla su ogni foglio del file e li copia nel file nuovo
    Dim oSheet As Sheet
    For Each oSheet In oDrawDoc.Sheets
        Call oSheet.Activate
        MsgBox oSheet.Name
        ' Da questa riga non riesco a farlo funzionare, il resto del codice non è testato
        Call oSheet.CopyTo(oNewDrawDoc)
    Next
   
    ' Registra il percorso e il nome del file originale
    Dim sFullFileName As String
    sFullFileName = oDrawDoc.FullFileName
    sFullFileName = Strings.Replace(sFullFileName, oDrawDoc.DisplayName, "Nuovo_" & oDrawDoc.DisplayName)
    ' Cancella il primo Foglio
    oNewDrawDoc.Sheets.Item(1).Delete
    'For Each oSheet In oNewDrawDoc.Sheets
    '    Call oSheet.Delete
    '    Exit For
    'Next
   
    ' Aggiorna il documento
    Call oNewDrawDoc.update
   
    ' Chiude il file originale
    Call oDrawDoc.Close(False)
   
    ' Salva il nuovo documento sovrascrivendo il file originale
    Call oNewDrawDoc.SaveAs(sFullFileName, False)
   
Err_ReducingFileSize:
    Debug.Print Err.Description
    Resume Next
End Sub
 

Catafratto

Utente Standard
Professione: Disegnatore/progettista
Software: Inventor 2020
Regione: Veneto
La butto lì: non è che hai Vault e i file da sovrascrivere sono in sola lettura?
 

Adahm

Utente standard
Professione: Consulente di Processo
Software: CatiaV5 / Inventor21
Regione: Lombardia
Ciao Catafratto,
ho capito dove era il problema. In pratica nei file che devo sistemare ci sono dei cartigli vecchi, che includono delle immagini, di conseguenza il comando di copia non funziona solo in quelle circostanze.
Per risolvere cancello il cartiglio prima di copiare il Foglio.

PS: Grazie per la riga di comando per eliminare il primo Foglio. Non mettevo la "s" in "Sheet" nella riga oNewDrawDoc.Sheets.Item(1).Delete, perciò avevo ciclato.
 

Adahm

Utente standard
Professione: Consulente di Processo
Software: CatiaV5 / Inventor21
Regione: Lombardia
La butto lì: non è che hai Vault e i file da sovrascrivere sono in sola lettura?
Sì, ho Vault, ma li estraggo, eseguo la macro e li archivio.
Così funziona.
Tu sai se si può fare l'operazione direttamente in Vault?
Non ho mai scritto codice in Vault.
 

Catafratto

Utente Standard
Professione: Disegnatore/progettista
Software: Inventor 2020
Regione: Veneto
Non so, mai usato Vault e non so quanto sia gestibile via VBA...
 

Adahm

Utente standard
Professione: Consulente di Processo
Software: CatiaV5 / Inventor21
Regione: Lombardia
Mi pare che si possa gestire solo con C# o C++, non in VBA.
Per questo non sono felicissimo :D
 

Adahm

Utente standard
Professione: Consulente di Processo
Software: CatiaV5 / Inventor21
Regione: Lombardia
Riprendo la discussione per un approfondimento.
Sempre nella procedura sopra descritta, nei comandi di:
- Chiusura file (senza salvare)
- Salvataggio file
Bisogna sempre confermare con Sì o No o quel che serve.
Qualcuno sa se è possibile specificare nelle righe di comando se salvare o meno, senza far uscire le finestre di conferma?
 

Catafratto

Utente Standard
Professione: Disegnatore/progettista
Software: Inventor 2020
Regione: Veneto
Per disabilitare i prompt dovrebbe essere questa:
ThisApplication.SilentOperation = True
 

Adahm

Utente standard
Professione: Consulente di Processo
Software: CatiaV5 / Inventor21
Regione: Lombardia
Perfetto, grazie Catafratto!
Dall'help in linea, pensavo che il (false) nel comando .close(false) non mi chiedesse di salvare, ma evidentemente serve a qualche cosa d'altro. Tu sai a cosa?
 

Catafratto

Utente Standard
Professione: Disegnatore/progettista
Software: Inventor 2020
Regione: Veneto
Questo quello che so / ho capito

Document.Close( [SkipSave] As Boolean )
.close(true) -> chiude senza salvare
.close(false) -> salva e chiude
ThisApplication.SilentOperation = False -> esce la finestrella di dialogo
ThisApplication.SilentOperation = True -> salva direttamente senza chiedere conferma
 

Utenti online

Statistiche forum

Discussioni
55,428
Messaggi
473,875
Utenti registrati
95,494
Ultimo utente registrato
P.Righ

Top