02-14-2024
06:31 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
02-14-2024
06:31 PM
Hi @david_lowndes,
I think I use a slightly different method to you, and it's spliced from other rules we currently use so it may be a little longer than necesssary, but I use this to open all existing drawings of parts within an assembly.
'For mass updating small changes to part/assembly details to their respective Drawings. Sub main '[ 'Create a List of all Componenets Dim ComponentMap As NameValueMap = CreateComponentMap() 'Check for zero result, run updater If Not ComponentMap Is Nothing Then 'Check Assembly for files without a drawing Dim nonIDW As Integer = CheckAssemblyIDW(ComponentMap) UpdaterGo(ComponentMap, nonIDW) End If End Sub '] Sub UpdaterGo(vMap As NameValueMap, nonIDW As Integer) CreateProgressBar("Opening IDWs...", "Opened: ", (vMap.Count-nonIDW)) Dim i As Integer Dim vDoc As Document For i = 1 To vMap.Count Dim vFullFileName As String = vMap.Name(i) If CheckForFileIDW(vFullFileName) = True Then Dim idwPathName As String = Left(vFullFileName, Len(vFullFileName) -3) & "idw" vDoc = ThisApplication.Documents.Open(idwPathName, True) System.Threading.Thread.CurrentThread.Sleep(1000) IncrementProgressBar(1) End If Next ThisProgressBar.Close MessageBox.Show("All Drawings Opened.", "Update Complete", MessageBoxButtons.OK, MessageBoxIcon.Information) End Sub 'Check each file for a corresponding idw Function CheckForFileIDW(FileName As String) Dim State As Boolean = True Dim idwPathName As String = Left(FileName, Len(FileName) -3) & "idw" If (System.IO.File.Exists(idwPathName)) = 0 Then State = False Return State Else Return State End If End Function 'Uses BOM iLogic Rule to produce Component List Function CreateComponentMap() As NameValueMap 'Initialise Arguments Dim oRuleArguments As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap() 'find Project Folder Location in preparation to call external rule Dim IPJ As String Dim IPJ_Name As String Dim IPJ_Path As String Dim FNamePos As Long 'set a reference to the FileLocations object. IPJ = ThisApplication.FileLocations.FileLocationsFile 'get the location of the last backslash seperator FNamePos = InStrRev(IPJ, "\", -1) 'get the project file name with the file extension IPJ_Name = Right(IPJ, Len(IPJ) - FNamePos) 'get the path of the folder containing the project file IPJ_Folder_Location = Left(IPJ, Len(IPJ) -Len(IPJ_Name)) 'Call External Rule iLogicVb.RunExternalRule(IPJ_Folder_Location & "iLogic Scripts\BOM", oRuleArguments) 'Retreive Result Dim Result As NameValueMap Try Result = CType(oRuleArguments.Item("BOM"), NameValueMap) Catch Result = Nothing End Try Return Result End Function 'Cycle through all unique assembly parts to check for an idw Function CheckAssemblyIDW(oList As NameValueMap) oContext = ThisApplication.TransientObjects.CreateTranslationContext oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism oOptions = ThisApplication.TransientObjects.CreateNameValueMap oDataMedium = ThisApplication.TransientObjects.CreateDataMedium Dim i As Integer = 1 Dim k As Integer = 1 'Dim txtFileName As String = ThisDoc.PathAndFileName(True) & " No IDWs.txt" 'oMsg = System.IO.File.CreateText(txtFileName) ' oMsg.WriteLine("Parts and Assemblies with No IDW file:") 'oMsg.WriteLine("") For i = 1 To oList.Count Dim vFullFileName As String = oList.Name(i) Dim idwPathName As String = Left(vFullFileName, Len(vFullFileName) -3) & "idw" 'List parts/assemblies without an idw two to a line If (System.IO.File.Exists(idwPathName)) = 0 Then 'oMsg.WriteLine(k & ". " & Right(vFullFileName, Len(vFullFileName) -InStrRev(vFullFileName, "\")) & " ") k = k + 1 End If Next 'oMsg.Close 'ThisDoc.Launch(txtFileName) Return k - 1 End Function Dim ThisProgressBar As Inventor.ProgressBar Dim ThisProgressBarMessage As String Dim ThisProgressBarTotal As Integer Dim ThisProgressBarCount As Integer Sub CreateProgressBar(Title As String, Message As String, Total As Integer) ThisProgressBar = ThisApplication.CreateProgressBar(False, Total, Title) ThisProgressBarMessage = Message ThisProgressBarTotal = Total ThisProgressBarCount = 0 ProgressBarDisplay() End Sub Sub IncrementProgressBar(Change As Integer) ThisProgressBarCount = ThisProgressBarCount + Change ProgressBarDisplay() End Sub Sub ProgressBarDisplay() ThisProgressBar.Message = ThisProgressBarMessage & ThisProgressBarCount & "/" & ThisProgressBarTotal ThisProgressBar.UpdateProgress() End Sub