Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
Anonymous
in reply to: Anonymous

Okay, since nobody chimed in and I finally found a solution that (kind of) works, here it is.

 

Every manner of saveas I tried resulted in something not working. I ended up creating a filemanager object to use copyfile. By using replacereference within my sub, and calling it recursively while iterating if it found an ".iam", this copied all the frame members, and reference files, allowing the copied files to be driven by the copied master sketch. I ran into a problem with some parts that were derived out from the master sketch, so I essentially had to run the same sub, but looking for the keyword I needed and then referencing that particular referenced part. That... was... a... mouthful... so, here's the code. Maybe it'll help someone in the future. Oh, and FYI, as it sits there is little error handling, and you still get warned about the two reference IAMs claiming ownership of the reference IPT. There is no effect on either file structure past that that I can see. I'll double back at some point to fix the warnings if possible.



Sub SaveNew(newPath) 'declare the new assembly Dim newAsm As AssemblyDocument Set newAsm = ThisApplication.Documents.Open(filePath, False) 'save as on the new assembly Call newAsm.SaveAs(newPath, False) 'close the file newAsm.Close 'open the newly created assembly Dim asmCopy As AssemblyDocument Set asmCopy = ThisApplication.Documents.Open(newPath, False) Call CopyAll(asmCopy) asmCopy.Update asmCopy.Save2 Call ReplacePartRefs(asmCopy) asmCopy.Close End Sub Private Sub CopyAll(nAsm As AssemblyDocument) Dim fileMgr As fileManager Set fileMgr = ThisApplication.fileManager 'in case folder or file already exists we get an error we can ignore On Error Resume Next Dim fileDesc As FileDescriptor For Each fileDesc In nAsm.File.ReferencedFileDescriptors Dim flname As String flname = fileMgr.FileSystemObject.GetFileName(fileDesc.FullFileName) Dim newFolPath As String newFolPath = GetFolPath(nAsm.FullFileName) Call fileMgr.CopyFile(fileDesc.FullFileName, newFolPath & flname) Call fileDesc.ReplaceReference(newFolPath & flname) Dim fExtension As String fExtension = FileExtension(fileDesc.FullFileName) If fExtension = ".iam" Then Dim actAsm As AssemblyDocument Set actAsm = ThisApplication.Documents.Open(fileDesc.FullFileName, False) Call CopyAll(actAsm) actAsm.Update actAsm.Save2 actAsm.Close End If Next On Error GoTo 0 End Sub Private Sub ReplacePartRefs(nAsm As AssemblyDocument) Dim fileMgr As fileManager Set fileMgr = ThisApplication.fileManager 'in case folder or file already exists we get an error we can ignore On Error Resume Next Dim fileDesc As FileDescriptor For Each fileDesc In nAsm.File.ReferencedFileDescriptors Dim flname As String flname = fileMgr.FileSystemObject.GetFileName(fileDesc.FullFileName) Dim newFolPath As String newFolPath = GetFolPath(nAsm.FullFileName) Dim nameOnly As String nameOnly = FileName(flname) If InStr(1, flname, "Skin") > 0 Then Dim part As PartDocument Set part = ThisApplication.Documents.Open(fileDesc.FullFileName, False) Dim refFile As String refFile = FileName(part.File.ReferencedFileDescriptors(1).FullFileName) Call part.File.ReferencedFileDescriptors(1).ReplaceReference(newFolPath & refFile) part.Update part.Save2 part.Close End If Next On Error GoTo 0 End Sub ' Return the path of the input filename. Public Function GetFolPath(fPath) As String ' Extract the path by getting everything up to and ' including the last backslash "\". GetFolPath = Left$(fPath, InStrRev(fPath, "\")) End Function ' Return the name of the file, without the path. Public Function FileName(ByVal fName As String) As String ' Extract the filename by getting everything to ' the right of the last backslash. FileName = Right$(fName, Len(fName) - InStrRev(fName, "\")) End Function ' Return the extension of the input filename. Public Function FileExtension(ByVal ffName As String) As String ' Extract the filename by getting everthing to ' the right of the last backslash. Dim temp As String temp = Right$(ffName, Len(ffName) - InStrRev(ffName, "\")) ' Get the base filename by getting everything to ' the right of the last period ".". FileExtension = Right$(temp, Len(temp) - InStrRev(temp, ".") + 1) End Function