12-29-2023
01:07 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
12-29-2023
01:07 PM
Update 12/30/2023
I was mistaken, excelApp.Visible = True or False and excelApp.Quit() make no difference the excel app continues to show in task manger. When pushing Parameters from an assembly or simply creating a new Part I end up with an instance showing in task manager for every part.
Hi A.Acheson,
I was able to kill the process by changing excel.app.visible to true. I'm still uncertain if the rule is actually checking to see if the part number exists. My thoughts are that I would trigger the rule on creation of a new part and create some variation of the Code to run on sheet metal parts only when pushing Parameters from an Assembly.
See Code Below (borrowed and modified from a snippet by Curtis Waguespack)
Sub Main() Dim oDoc As Document = ThisDoc.Document iLogicVb.UpdateWhenDone = True Top: oFile = "Path\File.xlsx" 'define Excel Application object excelApp = CreateObject("Excel.Application") 'set Excel to run invisibly, change to true if you want to run it visibly excelApp.Visible = True 'suppress prompts (such as the compatibility checker) excelApp.DisplayAlerts = False Dim xCharArray() As Char = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ".ToCharArray Dim xNoArray() As Char = "0123456789".ToCharArray Dim xGenerator As System.Random = New System.Random() Dim xStr As String = String.Empty While xStr.Length < 10 If xGenerator.Next(0, 2) = 0 Then xStr &= xCharArray(xGenerator.Next(0, xCharArray.Length)) Else xStr &= xNoArray(xGenerator.Next(0, xNoArray.Length)) End If End While oValueToMatch = xStr Dim oProName1 As String = "Default Table Part Number" Dim oProName2 As String = "Default Table Description" Dim oProSet As Inventor.PropertySet = ThisApplication.ActiveDocument.PropertySets.Item("User Defined Properties") Dim oProp As Inventor.Property Try oProp = oProSet(oProName1) oProp = oProSet(oProName2) Catch oProp = oProSet.Add("",oProName1) oProp = oProSet.Add("",oProName2) End Try If iProperties.Value("Custom","Default Table Part Number")= "" Then GoTo DescNeeded Else If iProperties.Value("Custom","Default Table Part Number") > "" Then GoTo UserTime End If DescNeeded : Desc = InputBox("Excel Table Description, ie: FT90FM, End Cap", "Enter Description Here") iProperties.Value("Custom", "Default Table Part Number") = xStr iProperties.Value("Custom", "Default Table Description") = Desc oTime = Now.ToShortDateString oUser = iProperties.Value("Custom", "ModifiedBy") oDescriptionToMatch = Desc iProperties.Value("Project","Part Number") = xStr Goto StartPNAdd UserTime : iProperties.Value("Project","Part Number") = xStr oTime = Now.ToShortDateString oUser = iProperties.Value("Custom", "ModifiedBy") oDescriptionToMatch = iProperties.Value("Custom", "Default Table Description") StartPNAdd: If Dir(oFile) <> "" Then 'workbook exists, open it oWB = excelApp.Workbooks.Open(oFile) oWS = oWB.Worksheets(1) Else Return 'exit rule End If 'Loop through the rows In column A For iRow = 2 To oWS.UsedRange.Rows.Count 'get value of the cell oCellValue = oWS.Cells(iRow, "A" ).Value If oCellValue = oValueToMatch Then oWS.Cells(iRow, "A").Value = oCellValue + 1 oFound = True Goto Top Else oFound = False End If Next iRow If oFound = False Then oWS.Cells(oWS.UsedRange.Rows.Count + 1, "A").Value = oValueToMatch oWS.Cells(oWS.UsedRange.Rows.Count, "B").Value = oDescriptionToMatch oWS.Cells(oWS.UsedRange.Rows.Count, "C").Value = oTime oWS.Cells(oWS.UsedRange.Rows.Count, "D").Value = oUser End If 'set all of the columns to autofit excelApp.Columns.AutoFit 'save the file oWB.Save oDoc.Save 'close the workbook and the Excel Application oWB.Close excelApp.Quit() 'excelApp = Nothing End Sub Thanks,
Brent