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

Rule to Open Drawing of every part in Assembly

david_lowndes
Participant

Rule to Open Drawing of every part in Assembly

david_lowndes
Participant
Participant

Hi.

 

I have written rules to open drawings based on the BOM before, but now I am using vault I am trying to use 

 

ThisApplication.CommandManager.ControlDefinitions.Item("VaultOpenDesignDocFromVault").Execute

I know to get this to work I need to select an Occurrence first, so I am using 

 

ThisApplication.CommandManager.DoSelect(oOcc)

But my rule just keeps opening the same drawing over and over. Do I need to clear the selection somehow?

 

Here is the code in question:

 

    For i =1 To oBOMRows.Count
    
        
        
        BOMItem = oBOMView.BOMRows.Item(i)
        
        oCompDef = BOMItem.ComponentDefinitions.Item(1)
        
        'If oCompDef.BOMStructure <> 51972 Then
        If oCompDef.BOMStructure <> 51973 Then
        
            PartNum = oCompDef.Document.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
            VenNum = oCompDef.Document.PropertySets.Item("Design Tracking Properties").Item("Vendor").Value
            DesNum = oCompDef.Document.PropertySets.Item("Design Tracking Properties").Item("Description").Value
            'PartNum = oCompDef.Document.PropertySets.Item(4).Item(2).Value
                    
            Dim LongName As String = PartNum & " " & DesNum 
            
			Try
				
				MsgBox(PartNum)
				oOcc = Component.InventorComponent(PartNum & ":1")
				
				'MsgBox("Got Occurence of " & PartNum)
				
				CurrentDocName = oCompDef.Document.FullFileName
				
				
				
				ThisApplication.CommandManager.DoSelect(oOcc)
				
				
				
				ThisApplication.CommandManager.ControlDefinitions.Item("VaultOpenDesignDocFromVault").Execute
				
				
				
			Catch
				
				Msgbox("Failed to get" & PartNum)
            End Try
			
			                            
            
        Else
        
            'do nothing
        
        End If
		
		Try
			
			DrawDoc = ThisApplication.ActiveDocument
			
			DrawName = DrawDoc.FullFileName
			
			
			
			
			DrawDoc.Close
		
		Catch
			
		End Try
		
		
        
    Next

 Thanks to anyone who can help

0 Likes
Reply
232 Views
3 Replies
Replies (3)

bradeneuropeArthur
Mentor
Mentor

I would use selectset and selectset.select and than run the controldefintion open from vault. Than clear the selectset.

Regards,

Arthur Knoors

Autodesk Affiliations:

Autodesk Software:Inventor Professional 2025 | Vault Professional 2024 | Autocad Mechanical 2024
Programming Skills:Vba | Vb.net (Add ins Vault / Inventor, Applications) | I-logic
Programming Examples:Drawing List!|Toggle Drawing Sheet!|Workplane Resize!|Drawing View Locker!|Multi Sheet to Mono Sheet!|Drawing Weld Symbols!|Drawing View Label Align!|Open From Balloon!|Model State Lock!
Posts and Ideas:Dimension Component!|Partlist Export!|Derive I-properties!|Vault Prompts Via API!|Vault Handbook/Manual!|Drawing Toggle Sheets!|Vault Defer Update!


! For administrative reasons, please mark a "Solution as solved" when the issue is solved !

0 Likes

david_lowndes
Participant
Participant

Thank you

 

Clearing the selectset makes sense.

 

However, I am having trouble using selectset to select the part to open the drawing of, any advice on this?

0 Likes

ross_goldbergQU7DJ
Participant
Participant

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

 

0 Likes