I am trying to create a batch macro that takes several individual .dft documents (only one sheet inside) and combines them into one only document (with many sheets). I dont mind if the macro copies/pastes the whole sheet, or only the content in the sheet into a new sheet.
I have been searching the internet, but found very little information, and did not manage to do it myself.
For this reason, I would like to ask if anybody could help me do it. I am even willing to pay a reasonable price for the job.
Thank you very much in advance,
First of all, thank you all for your kind help.
I try to explain as best as possible.
We start with a list of .dft documents, each of them with one single sheet inside, containing a 2D drawing.
We would need the macro to:
- Create a new .dft (or open a blank .dft template)
- Open the first .dft document in the list and copy/paste the whole sheet in the new .dft.
- Repeat in batch mode through the rest of the list.
--> The number of .dft docs in the list is not fixed. It will vary, so the Macro will have to count them, or have an input variable (number of docs), which will be introduced manually before running the macro.
--> If possible, we would prefer giving the input .dft list as follows:
Solidedge version used: ST6
Looking forward to hearing your thoughts!!
Last time a customer ask for this sort of fonctionallity we ended saving multiple documents as PDF then make a fusion of those PDF.
Creating draft document with a big number of sheets isn't a good idea for save and update.
In case you really need to add all the sheets to a document here is an example where we add all the sheets for the documents in the folder training of Solid Edge 2019 in an open draft file.
Private Sub Start_DraftFusion() Dim objApp As SolidEdgeFramework.Application = Nothing Dim objDoc As SolidEdgeDraft.DraftDocument = Nothing Dim FileList As New List(Of String) FileList.AddRange(System.IO.Directory.GetFiles("C:\Program Files\Siemens\Solid Edge 2019\Training", "*dft")) Try objApp = SolidEdgeCommunity.SolidEdgeUtils.Connect() Catch ex As Exception objApp = Nothing End Try If objApp IsNot Nothing Then 'Get Draft Document Try objDoc = DirectCast(objApp.ActiveDocument, SolidEdgeDraft.DraftDocument) Catch ex As Exception objDoc = Nothing End Try If objDoc IsNot Nothing Then Dim SheetList As New List(Of String) For Each objsheet As SolidEdgeDraft.Sheet In objDoc.Sections.WorkingSection.Sheets SheetList.Add(objsheet.Name) Next For Each myFile In FileList CopySheet(objDoc, SheetList, myFile) Next End If End If End Sub Private Sub CopySheet(ByRef TargetDoc As SolidEdgeDraft.DraftDocument, ByRef TargetSheetList As List(Of String), ByVal FileName As String) If File.Exists(FileName) Then Dim SourceDoc As SolidEdgeFramework.SolidEdgeDocument = Nothing Try SourceDoc = TargetDoc.Application.Documents.Open(FileName) Catch ex As Exception End Try If SourceDoc IsNot Nothing Then For Each objsheet As SolidEdgeDraft.Sheet In SourceDoc.Sections.WorkingSection.Sheets 'Get BackGround name Dim SourceBackGroundSheet As String = "" Try SourceBackGroundSheet = objsheet.Background.Name Catch ex As Exception End Try SourceDoc.Activate() objsheet.Activate() 'Copy Data Dim objSelectSet As SolidEdgeFramework.SelectSet TargetDoc.Application.ActiveSelectSet.RemoveAll() objSelectSet = TargetDoc.Application.ActiveSelectSet objSelectSet.SuspendDisplay() objSelectSet.AddAll() objSelectSet.Copy() Dim NewSheetName As String = objsheet.Name If TargetSheetList.Contains(NewSheetName) Then Dim i As Integer = 1 Dim NewSheetNameCompute As String = NewSheetName Do While TargetSheetList.Contains(NewSheetNameCompute) NewSheetNameCompute = NewSheetName & "_" & i i += 1 Loop NewSheetName = NewSheetNameCompute End If 'Create New Sheet TargetDoc.Activate() Dim ObjNewSheet As Sheet = Nothing Try ObjNewSheet = TargetDoc.Sheets.AddSheet(NewSheetName, SolidEdgeDraft.SheetSectionTypeConstants.igWorkingSection) Catch ex As Exception End Try If ObjNewSheet IsNot Nothing Then ObjNewSheet.SheetSetup.SheetSizeOption = objsheet.SheetSetup.SheetSizeOption For Each objBackGround As SolidEdgeDraft.Sheet In TargetDoc.Sections.BackgroundSection.Sheets 'Get BackGround Infos Try If objBackGround.Name = SourceBackGroundSheet Then ObjNewSheet.Background = objBackGround Exit For End If Catch ex As Exception End Try Next ObjNewSheet.Activate() TargetDoc.Application.DoIdle() 'Paste in New Sheet TargetDoc.Application.ActiveWindow.Paste() TargetDoc.Application.DoIdle() TargetSheetList.Add(NewSheetName) objSelectSet = Nothing End If Next SourceDoc.Close(False) End If End If End Sub
Note that this is only an example and may need some adjustment and debug, for example I'm not sure if background sheet are correctly handle.