Export to DWG and move older version - Several sheets drawing

Export to DWG and move older version - Several sheets drawing

guiherme.leite.relco
Explorer Explorer
261 Views
2 Replies
Message 1 of 3

Export to DWG and move older version - Several sheets drawing

guiherme.leite.relco
Explorer
Explorer

Hi,

I have this code to export to PDF and Autocad DWG and move older version to an "OldVersions" folder.

The problem is when the drawing has more than one sheet. The exported dwg file come with "_Sheet_X.dwg" and don't move the older version. I have tried lots of things and tips that I found her, but nothing worked.
Can you help me solve it?

 

 

Sub Main
	
	For Each doc As Document In ThisApplication.Documents.VisibleDocuments
		If doc.DocumentType = DocumentTypeEnum.kDrawingDocumentObject Then
			Call Save_As_DWG_CAD(doc)
		End If
	Next
	
	For Each doc  As Document In ThisApplication.Documents.VisibleDocuments
		If doc.DocumentType = DocumentTypeEnum.kDrawingDocumentObject Then
			Call Save_As_PDF(doc)
		End If
	Next	

	
	MessageBox.Show("All files created", "Ready!", MessageBoxButtons.OK)

	
End Sub


Sub Save_As_DWG_CAD(oDoc As Document)

	oPath = IO.Path.GetDirectoryName(oDoc.FullFileName)
	oFileName = IO.Path.GetFileNameWithoutExtension(oDoc.FullFileName) 'without extension
	oRevNum = oDoc.PropertySets.Item(1).Item("Revision Number").Value

	Dim DWGAddIn As TranslatorAddIn
	DWGAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC2-122E-11D5-8E91-0010B541CD80}")

	'oDocument = ThisApplication.ActiveDocument
	
	Dim oContext As TranslationContext
	oContext = ThisApplication.TransientObjects.CreateTranslationContext
	oContext.Type = kFileBrowseIOMechanism

    'Create a NameValueMap object
    oOptions = ThisApplication.TransientObjects.CreateNameValueMap

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

	'oDocument = ThisApplication.ActiveDocument
	'oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
	
	'Sets the directory that the file should be saved in
	oFolder = oPath & "\2D_CAD"

	'checks to see if that directory exists, if not, it is created
	If Not System.IO.Directory.Exists(oFolder) Then
		System.IO.Directory.CreateDirectory(oFolder)
	End If	
	
	oFile = oFileName & "_" & oRevNum & ".dwg"
	
	'Saves the file in the desired location
	oDataMediumDWG.FileName = oFolder + "\" + oFile
	
		Dim strIniFile As String
    strIniFile = "Z:\Biblioteca 3D\Ilogic\saveDWG_CAD.ini"
	oOptions.Value("Export_Acad_IniFile") = strIniFile
		
	
	'Check to see if the file already exists, if it does, ask if you want to overwrite it or not.
	If System.IO.File.Exists(oDataMediumDWG.FileName) = True Then
		oAnswer = MsgBox( oFile & " already exists." & vbCrLf &
		"Do you want to overwrite it?", vbYesNo + vbQuestion + vbDefaultButton2, "DWG ALREADY EXISTS")
		If oAnswer = vbNo Then Exit Sub
	End If	
	
	
	'Publish document
	DWGAddIn.SaveCopyAs(oDoc, oContext, oOptions, oDataMediumDWG)


	'Colocar revisao anterior em OldVersions
	
	If oRevNum >= "A" Then
	
	Dim EarlyRev As String = Chr(Asc(oRevNum) -1)
	Dim FileCurrentName = oFileName & "_" & EarlyRev & ".dwg"
	Dim FileCurrent As String = oFolder & "\" & FileCurrentName
	Dim oObs As String = oFolder & "\OldVersions\"
	Dim FileObs As String = oObs & FileCurrentName

	
		
		If Not System.IO.Directory.Exists(oObs) Then
    		System.IO.Directory.CreateDirectory(oObs)
		End If
		
  		If System.IO.File.Exists(FileCurrent) = True Then
		    System.IO.File.Move(FileCurrent, FileObs)
    
		End If
	
	
	End If
	
End Sub

 

 

guihermeleiterelco_0-1671041671561.png

 

0 Likes
262 Views
2 Replies
Replies (2)
Message 2 of 3

JelteDeJong
Mentor
Mentor

maybe this works for you:

Public Sub Save_As_DWG_CAD(oDoc As Document)

	Dim oPath = IO.Path.GetDirectoryName(oDoc.FullFileName)
	Dim oFileName = IO.Path.GetFileNameWithoutExtension(oDoc.FullFileName) 'without extension
	Dim oRevNum = oDoc.PropertySets.Item(1).Item("Revision Number").Value

	Dim DWGAddIn As TranslatorAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC2-122E-11D5-8E91-0010B541CD80}")

	Dim oContext As TranslationContext = ThisApplication.TransientObjects.CreateTranslationContext
	oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism

	'Create a NameValueMap object
	Dim oOptions As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap

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


	'Sets the directory that the file should be saved in
	Dim oFolder = IO.Path.Combine(oPath, "2D_CAD")
	Dim dirInfo As New IO.DirectoryInfo(oFolder)

	'checks to see if that directory exists, if not, it is created
	If Not dirInfo.Exists Then dirInfo.Create()


	' Move old versions
	If oRevNum >= "A" Then
		Dim oldVersionsFolderName = IO.Path.Combine(dirInfo.FullName, "OldVersions")
		Dim oldVersionsFolderInfo As New IO.DirectoryInfo(oldVersionsFolderName)
		If Not oldVersionsFolderInfo.Exists Then oldVersionsFolderInfo.Create()

		For Each fileInfo As IO.FileInfo In dirInfo.GetFiles(oFileName & "*.dwg")
			Dim newFileName = IO.Path.Combine(oldVersionsFolderInfo.FullName, fileInfo.Name)
			fileInfo.MoveTo(newFileName)
		Next
	End If

	'Create new file name
	Dim oFile = String.Format("{0}_{1}.dwg", oFileName, oRevNum)

	'Saves the file in the desired location
	oDataMediumDWG.FileName = IO.Path.Combine(oFolder, oFile)

	oOptions.Value("Export_Acad_IniFile") = "Z:\Biblioteca 3D\Ilogic\saveDWG_CAD.ini"

	'Check to see if the file already exists, if it does, ask if you want to overwrite it or not.
	If System.IO.File.Exists(oDataMediumDWG.FileName) = True Then
		Dim oAnswer = MsgBox(oFile & " already exists." & vbCrLf &
			"Do you want to overwrite it?", vbYesNo + vbQuestion + vbDefaultButton2, "DWG ALREADY EXISTS")
		If oAnswer = vbNo Then Exit Sub
	End If


	'Publish document
	DWGAddIn.SaveCopyAs(oDoc, oContext, oOptions, oDataMediumDWG)
End Sub

Jelte de Jong
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

EESignature


Blog: hjalte.nl - github.com

Message 3 of 3

guiherme.leite.relco
Explorer
Explorer

Hello, 

At first, it worked. But when I try overwrite, I get an error, it says is "not allowed to create an existent file".

In the rule there's a part to check if I want to overwrite, but doesn't works, apparently.

guihermeleiterelco_0-1671193016163.png

guihermeleiterelco_1-1671193024647.png

 

 

0 Likes