Esportazione "automatica" idw to pdf-dxf

Matteo Cappelli dis.CAD

Utente Standard
Professione: disegnatore
Software: Inventor / autocad
Regione: Emilia romagna
per il problema che "zippa", devi per una volta esportare manualmente con il comando:
FILE - esporta - Esporta in dwg, seleziona dwg per autocad, selezionare opzioni e disattivare l'opzione PACK&GO
salva dwg autocad.jpg
 

andrea_botti

Utente poco attivo
Professione: studente
Software: inventor/mechanical/soldworks
Regione: lombardia

andrea_botti

Utente poco attivo
Professione: studente
Software: inventor/mechanical/soldworks
Regione: lombardia
@Catafratto, noto con piacere la tua grande disponibilità. :)



Vorrei sapere, se non è chiedere troppo, come poter impostare una configurazione particolare per l'esportazione dei dwg, vedi immagine

1651581963471.png



attualemente sto lavorando con questo codice (non mi servono il numero di magazzino e il dwf quindi li ho commentati)



Public Sub Pubblica() ' Obtain reference to drawing Dim oDoc As Document Set oDoc = ThisApplication.ActiveDocument ' DESTINATION FOLDER ' --------------------------------------------------- Dim sExportPath As String sExportPath = "C:\Users\a.botticini\Desktop\#Esportati_DWG-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 tavola? ", "Inserisci 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") = 1 '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
 

Utenti online

Statistiche forum

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

Top