I am trying to create a VBA macro to copy al of the files referenced in the active document to a new location.
Some similar Apprentice examples use the Inventor.FileSaveAs to collect all of the references before executing the save as but I cannot get it to work.
Here is my code limited to just the current document for testing purposes:
it fails at: Call oFileSaveAs.AddFileToSave(oDoc, sTargetFile)
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Set references to active document, Target Directory, Filename.
Dim oDoc As Inventor.Document
Set oDoc = ThisApplication.ActiveDocument
Dim sFullFileName As String
sFullFileName = oDoc.FullFileName
Dim sFilename As String
sFilename = Right(sFullFileName, Len(sFullFileName) - InStrRev(sFullFileName, "\"))
' Set Target Directory & Filename
Dim sTargetDir As String
sTargetDir = "C:\Test\"
Dim sTargetFile As String
sTargetFile = sTargetDir & sFilename
' Set a reference to the FileSaveAs object.
Dim oFileSaveAs As Inventor.fileSaveAs
Call oFileSaveAs.AddFileToSave(oDoc, sTargetFile)
Call oFileSaveAs.ExecuteSave
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Any help would be appreciated.
Alasdair
References used:
http://www.mcadforums.com/forums/viewtopic.php?f=15&t=12087&p=84255&hilit=filesaveas#p84255
SDK sample: C:\Users\Public\Documents\Autodesk\Inventor 2013\SDK\UserTools\CopyDesign\Source\form1.vb
Solved! Go to Solution.
Solved by alasdair.currie. Go to Solution.
I have resolved this issue, for anyone that needs to do something similar here is the final code.
Public Sub Copy() ' Set references to active document, Target Directory, Filename. Dim oDoc As Inventor.Document Set oDoc = ThisApplication.ActiveDocument Dim sFullFileName As String sFullFileName = oDoc.FullFileName Dim sFilename As String sFilename = Right(sFullFileName, Len(sFullFileName) - InStrRev(sFullFileName, "\")) ' Set Target Directory & Filename Dim sTargetDir As String sTargetDir = "C:\Temp\" Dim sTargetFile As String sTargetFile = sTargetDir & sFilename
'Check to see if the file is already in the target directory If sFullFileName = sTargetFile Then GoTo FileExists ' Copy the Active Document Call oDoc.SaveAs(sTargetFile, True) ' Get all of the documents referenced by the active document. Dim allRefDocs As Inventor.Documents ' Dim oRefDoc As Inventor.Document For Each oRefDoc In oDoc.AllReferencedDocuments ' Get the full filename of the current document. Dim sRefFullFilename As String sRefFullFilename = oRefDoc.FullFileName Dim sRefFilename As String sRefFilename = Right(sRefFullFilename, Len(sRefFullFilename) - InStrRev(sRefFullFilename, "\")) Dim sRefTargetFile As String sRefTargetFile = sTargetDir & sRefFilename ' Copy the Reference Documents, check if they exist already If Dir(sRefTargetFile) = "" Then Call oRefDoc.SaveAs(sRefTargetFile, True) End If Next ' Close Current Document & Open New document Call oDoc.Close Dim oNewDoc As Inventor.Document Set oNewDoc = ThisApplication.Documents.Open(sTargetFile) 'ZoomAll ThisApplication.ActiveView.Fit True GoTo Finished FileExists: MsgBox "Your file is already in C:\Temp..." Finished: End Sub
Can you write a code which can copy the flat pattern view (if present) from all drawings(.idw) in a folder into one common development drawing?
Hi alasdair,
I have found your code to be useful but i would like to modify it a little and need some help.
I changed the string srefFileName to:
sRefFilename = "1130" & Right(sRefFullFilename, 17)
This saves the reference files in this format successfully.But inside the part file the iproperty as well as model browser name does not change according to the file name.
Is there a way i can incorportate the change in this code itself so that the iproperty name becomes same as the filename?
I would be grateful for your help.
Thanks,
Sid
using Inventor 2011
Hi Sid,
I have not tried to update iProperties from the filename but this should be possible.
To get the filename without extension you can use:
' Get Filename Dim sFullPathFilename As String Dim sFullFileName As String Dim sFilename As String sFullPathFilename = FullFileName sFullFileName = Right(sFullPathFilename, Len(sFullPathFilename) - InStrRev(sFullPathFilename, "\")) sFilename = Left(sFullFileName, Len(sFullFileName) - 4)
Also see:
http://modthemachine.typepad.com/my_weblog/2010/05/working-with-filenames.html
Then set the property you want to sFilename with something like this:
' Get the design tracking property set. Dim invDesignInfo As PropertySet Set invDesignInfo = invDoc.PropertySets.Item("Design Tracking Properties") 'Set the Part number to filename Dim invProjectProperty As Property Set invProjectProperty = invDesignInfo("Part Number") invProjectProperty.Value = "sFilename"
More Info: http://download.autodesk.com/us/community/mfg/Part_2.pdf
I hope that helps.
Alasdair
The code works good, except when trying to copy frame generator assemblies. It cannot save the skeleton.ipt part. It says it must be saved together with frame.iam.
Any solutions to this?
Regards
Alexandru
Hi Alexandru,
You could try a different approach if it doesn't work for Frame Generator asemblies.
Here is some code for listing all of the files in the active docuemnt
Dim oDoc As Document
Dim Refs As String
Refs = ThisApplication.ActiveDocument.FullDocumentName & vbCrLf
Set oDoc = ThisApplication.ActiveDocument
For i = 1 To oDoc.AllReferencedDocuments.count
Refs = Refs & oDoc.AllReferencedDocuments.Item(i).FullDocumentName & vbCrLf
Next
Hi.
Loved this code!
I only want to copy files in workspace folder, and avoid library files.
Any way to keep folder hierarchy as in Workspace?
Thanks!