Anonymous
in reply to:
Anonymous
02-05-2018
12:29 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
02-05-2018
12:29 PM
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