VBA Frame Generator Copy Fun - "can only be saved in the context of"

VBA Frame Generator Copy Fun - "can only be saved in the context of"

Anonymous
Not applicable
902 Views
3 Replies
Message 1 of 4

VBA Frame Generator Copy Fun - "can only be saved in the context of"

Anonymous
Not applicable

I'm back again! Hopefully this will taper off sooner than later.

 

I have written a routine that does a save as on an assembly that is a mixture of FG members and parts. The FG assembly sits on it's own and there is a master assembly where everything is placed and constrained. The goal is to be able to go into the newly copied assembly's master sketch, change width and\or height, and updated the needed documents until the master assembly and all of it's components reflect the change. I have everything working but the frame members. This morning I ran into an error of "can only be saved in the context of" which was in relation to the skeleton and assembly created by FG (the files you input names for on the initial run of placing members).

 

My FG assembly contains, essentially, two subassemblies. One is a door jam and the other a door frame. I need the generated files that are giving me problems in order to update the members contained in both. To get the code to run I had to demote both subassemblies, but that left the needed files out. Only demoting one, so the file structure was still in place resulted in the error. As did placing the assembly into the master assembly and suppressing it.

 

I'm a bit at a loss. Is there an exception I could write in order to get these files to save? I'm happy to post the code if it would help.

 

Any help is greatly appreciated.

0 Likes
Accepted solutions (1)
903 Views
3 Replies
Replies (3)
Message 2 of 4

Anonymous
Not applicable

Sort of fixed the problem, but created a new one. I added an exception to skip the offending ipt. Doing so still allows everything to update as it should from the master sketch, BUT, it won't iterate all the way through the ReplaceComponents sub. I am thinking it wants to see that other file, but since it's not there it errors out. I have tried to add an exception there as well to skip the recursive call on that specific assembly but no joy. 

 

Any input would help at this point (as will going home and forgetting about all this for a little while!)

 

Public newPath As String
Public FilePath As String
Public newFolPath As String
Public file_name As String



Public Sub PlaceCompartment()
    
    'get the object from the active document
    
    Dim asmDoc As AssemblyDocument
    Set asmDoc = ThisApplication.ActiveDocument
    
    'on run, display the different options with a GUI and buttons - also sets the filepath to the desired assembly file
    
    AsmForm.Show
    
    'get new path
    
    Call GetPath
        
    'perform save as of needed assembly and parts
    
    Call SaveNew(FilePath)
    
    'ComponentReplace(
    
    
End Sub


Public Function GetPath() As String
    
    'set up the dialog
    Dim fileDlg As FileDialog
    
    'create file dialog object
    Call ThisApplication.CreateFileDialog(fileDlg)
    
    'define filter
    fileDlg.Filter = "Assembly File (*.iam)|*.iam"
    
    'define the part and assembly files filter to be the default filter
    fileDlg.FilterIndex = 1
    
    'file dialog title
    fileDlg.DialogTitle = "Save File As"
    
    'throw error when user hits cancel
    fileDlg.CancelError = True
    
    'show file dialog
    On Error Resume Next
    fileDlg.ShowSave
    
    newPath = fileDlg.Filename

    Call GetFolderPath(newPath)
       
       
End Function

' Return the path of the input filename.
Public Function GetFolderPath(fPath) As String

    ' Extract the path by getting everything up to and
    ' including the last backslash "\".
    newFolPath = Left$(fPath, InStrRev(fPath, "\"))
    
End Function

Sub SaveNew(fPath)
       
    'declare the new assembly
    Dim newAsm As AssemblyDocument
    Set newAsm = ThisApplication.Documents.Open(fPath, 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)
    
    'save as for all the components in the active assembly
    Call CopyOccs(asmCopy)
    

    
    'replace existing components with newly created components in assembly's folder
    Call ReplaceOccs(asmCopy.ComponentDefinition.Occurrences)
    
    'save the changes!
    asmCopy.Save
    
    'close the document!
    asmCopy.Close
    
    
           

End Sub


Private Sub CopyOccs(asmDoc As AssemblyDocument) 'the sub locates all referenced files and copies them to the new directory
    
    'declare enumerator and assign the docs from the passed (opened) file
    Dim refDocs As DocumentsEnumerator
    Set refDocs = asmDoc.AllReferencedDocuments
    
    'set count variable for iteration = the number of reference docs
    Dim compCount As Integer
    compCount = refDocs.Count
    
    Dim refdoc As Document
    
    'Dim progressBar As Inventor.progressBar
    
    'Set progressBar = ThisApplication.CreateProgressBar(False, compCount, "Copying Assembly...", True)
    
    'Dim amount As Integer
    'amount = 100 / compCount
    
    'iterate through the reference documents
    For j = 1 To compCount
    
        
        Set refdoc = refDocs.Item(j)
        
        If refdoc.FullFileName = "C:\Users\Michael Peterson\CAD Support Files\Compartments\Single Door\Single Door FG Files\Single Door FG Frame.ipt" Then
            j = j + 1
        
        
        
        Else
        
            'get the active document's full file name to strip all preceding the name
            
            Dim newDocName As String
            newDocName = refdoc.FullFileName
            
            'call the function to strip out the name
            Call FNameOnly(newDocName)
            
            'concatenate the new folder path with the active file name
            Dim newDocPath As String
            newDocPath = newFolPath & file_name
            
            Call refdoc.SaveAs(newDocPath, False)
            
            
            
            'Set progressBar.Message
            
            'progressBar.UpdateProgress
            
            End If
            
            
            Next
    
    'progressBar.Close

    
End Sub

Private Sub ReplaceOccs(asmOccs As ComponentOccurrences)
    

    
    'error for if the active doc is not an assembly
    If asmOccs.Count = 0 Then
        MsgBox ("Assembly does not include any occurrences")
        Exit Sub
    End If
    
    'get the number of iterations needed
    Dim compCount As Integer
    compCount = asmOccs.Count
    
    'iterate through the occurrences
    For i = 1 To compCount
        
        'set the current occurrence
        Dim compOcc As ComponentOccurrence
        Set compOcc = asmOccs(i)
        
        'get occurrence's path
        Dim filen As String
        filen = compOcc.Definition.Document.FullFileName
        
        'strip out all but the name
        Call FNameOnly(filen)
        
        'concatenate with newFolPath
        Dim compPath As String
        compPath = newFolPath & file_name
        
        'replace the current occurrence with the new one
        Call compOcc.Replace(compPath, False)
        
        'recursively call the function if a subassembly
        If compOcc.DefinitionDocumentType = kAssemblyDocumentObject Then
        
'CHECK HERE IN MORNING IF THERE IS STILL A PROBLEM
        
            If filen = "C:\Users\Michael Peterson\CAD Support Files\Compartments\Single Door\Single Door FG Files\Single Door FG Frame.iam" Then
                
                i = i + 1
            
            Else
            
                Call ReplaceOccs(compOcc.SubOccurrences)
                
            End If
            
        End If
        
    Next
    
    
End Sub



' Return the name of the file, without the path.
Public Function FNameOnly(ByVal fName As String) As String

    ' Extract the filename by getting everything to
    ' the right of the last backslash.
    file_name = Right$(fName, Len(fName) - InStrRev(fName, "\"))
               
End Function

Public Sub ReplaceComponents()

End Sub

Message 3 of 4

Anonymous
Not applicable

Still going at this problem. I need:

 

1. To save the needed IPTs in order to update the frame members with a change in parameter to the copied sketch IPT. I was able to get this to work (and hope I did a save as of the functioning code) by closing the active assembly and writing exceptions to just save the IAM and IPT. 

 

2. To be able to change the reference in the generated IAM to the copied IPT. Swapping components in the new assembly doesn't accomplish this as the generated IAM stays linked to the reference IPT in the template folder (where I store the assemblies and parts being copied). I thought maybe reference key may be the ticket, but I don't really know.

 

Again, any help would be greatly appreciated.

0 Likes
Message 4 of 4

Anonymous
Not applicable
Accepted solution

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