- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I found the answer on my own.
I had to modify the custom parameter field in the iFactory each time I edited a child. Then, when I set the row of the child, it grabs that parameter. I was unable to specify parameter in the .ChangeRow call.
I think iFactories were intended to have only one row per child instance. This is not our setup. We have thickness and length in dropdowns/keys but the length is a custom parameter, is set to "1 in", and we do not have separate rows for separate lengths. Instead when you place the factory to create an instance/child, you type whatever you want into the custom parameter.
Technical notes:
You must close the excel table in order for the table to update
Editing the any of the key columns, even reformatting them, or even changing them and then changing them back, will break link to row.
Editing the custom parameter column will not break link.
Editing the iFactory in any way will make an update available to all children.
I have not attempted to edit the table inside Inventor (as opposed to excel)
This program runs best if no other excel processes are running (I've had OLE errors which are somehow not suppressed .DisplayAlerts)
Runtime is about 2 minutes per part with broken row and a couple seconds per part that just needs updating
Program seems stable running overnight.
Full code:
Option Explicit
Option Compare Text
Sub sciPartFolder()
'debug
Dim dTime As Double
'settings
Const sPath As String = "\\MKECOMP1\data\Eng Docs\Engineering Data\Core Kits, CNC Programs\_Closeout\"
Const sFactory As String = "_MCI Closeout.ipt"
Const sLogFilename As String = "FixLogCloseout.xlsx"
'main objects
Dim oFactory As iPartFactory
Dim ohFactorySheet As WorkSheet
Dim ocFactoryCells As Range
Dim obFactoryBook As Workbook
Dim asTable(30000, 5) As String 'empty, thk, wid, len, membername, pn#
Dim R As Double
Dim C As Integer
Dim sFile As String
Dim oDoc As Document
Dim oIpart As iPartMember
'parsing
Dim sThk As String
Dim sWid As String
Dim sLen As String
Const sDimFormat As String = "0.00"
'logging
Dim owLogBook As Workbook
Dim ocLogCells As Range
Dim L As Integer
'fix reference
Dim vComponentFolders As Variant
Const sComponentFolders As String = "_Closeout,_Tooling Foam,_Closeout Structural,_Contour Balsa,_Balsa" 'lightweight is not handled
Const sComponentFactories As String = "_MCI Closeout.ipt,_Tooling Foam.ipt,_Structural Closeout.ipt,_Contour Balsa.ipt,_Balsa.ipt"
Dim vComponentFactories As Variant
Dim sRemainder As String
Dim sFilename As String
Dim sFolderE1 As String 'folder above the filename
Dim F As Integer
Dim oDesc As DocumentDescriptor
Debug.Print "Starting at: " & Format(Now(), "hh:mm:ss")
'Call fnPubRoutineEnter
ThisApplication.SilentOperation = True
ThisApplication.Documents.CloseAll
'prep arrays
vComponentFolders = Strings.Split(sComponentFolders, ",")
vComponentFactories = Strings.Split(sComponentFactories, ",")
'load oFactory table
Set oDoc = ThisApplication.Documents.Open(sPath & sFactory, False)
If oDoc.ComponentDefinition.IsiPartFactory = False Then Stop
Set oFactory = oDoc.ComponentDefinition.iPartFactory
Set ohFactorySheet = oFactory.ExcelWorkSheet
Set ocFactoryCells = ohFactorySheet.Cells
Set obFactoryBook = ohFactorySheet.Parent
Debug.Print "Opened worksheet: " & Format(Now(), "hh:mm:ss")
For R = 1 To oFactory.TableRows.Count
For C = 1 To oFactory.TableColumns.Count
asTable(R, C) = Format(Replace(ocFactoryCells(R + 1, C), "in", ""), sDimFormat)
Next C
Next R
Debug.Print "Loaded worksheet: " & Format(Now(), "hh:mm:ss")
'open log file
Set owLogBook = Workbooks.Open("\\mkecomp1\data\SALES FOLDER\TRANSFER FILES\NJT-Sales Transfer\PROJECTS\Engineering\iParts\" & sLogFilename)
Set ocLogCells = owLogBook.Sheets(1).Cells
L = ocLogCells(dRowsMax, 1).End(xlUp).Row + 1
'scroll in folder to next to do
sFile = Dir(sPath & "*.ipt*")
Debug.Print ocLogCells(L - 1, 1).Value
Do Until sFile = ocLogCells(L - 1, 1).Value
sFile = Dir
Loop
sFile = Dir
'start processing fresh files
Do Until sFile = ""
Set oDoc = ThisApplication.Documents.Open(sPath & sFile, False)
If oDoc.ComponentDefinition.IsiPartMember = False Then GoTo NextFile
Set oIpart = oDoc.ComponentDefinition.iPartMember
If oIpart.CustomMember = False Then GoTo NextFile
Debug.Print oIpart.Name
'see if iPart needs attention. L think sometimes healthStatus might show ok when it isn't
If oIpart.HealthStatus = kUpToDateHealth _
Or oDoc.RequiresUpdate = False _
Or oDoc.RecentChanges = 0 Then GoTo NextFile
'fix broken links to factory
If oDoc.ReferencedDocumentDescriptors(1).ReferenceMissing = True Then
Set oDesc = oDoc.ReferencedDocumentDescriptors(1)
'parse
sRemainder = oDesc.FullDocumentName
sFilename = Right(sRemainder, Len(sRemainder) - InStrRev(sRemainder, "\"))
sRemainder = Left(sRemainder, InStrRev(sRemainder, "\") - 1)
sFolderE1 = Right(sRemainder, Len(sRemainder) - InStrRev(sRemainder, "\"))
sRemainder = Left(sRemainder, InStrRev(sRemainder, "\") - 1)
If InStr(sComponentFolders, sFolderE1) = 0 Then Stop
For F = LBound(vComponentFolders, 1) To UBound(vComponentFolders)
If sFolderE1 = vComponentFolders(F) Then Exit For
Next F
sFilename = vComponentFactories(F)
'fix it
Call oDesc.ReferencedFileDescriptor.ReplaceReference( _
"\\MKECOMP1\data\Eng Docs\Engineering Data\Core Kits, CNC Programs\" _
& sFolderE1 & "\" & sFilename)
End If
'see if needs to reconnect to row
On Error Resume Next
R = -1
R = oIpart.Row.Index 'if tables already loaded, this doesn't take time, even for parts which need updating (but are linked)
Debug.Print " Got row: " & Format(Now(), "hh:mm:ss")
On Error GoTo 0
If R = -1 Then
'data we might need / find row
'dims via name, can also via oDoc.PropertySets(4)("Thickness")
sThk = Left(oIpart.Name, 4)
sWid = Mid(oIpart.Name, 6, InStrRev(oIpart.Name, "x") - 6)
sLen = Mid(oIpart.Name, InStrRev(oIpart.Name, "x") + 1, Len(oIpart.Name) - 4 - InStrRev(oIpart.Name, "x"))
'find row
For R = 1 To oFactory.TableRows.Count
If asTable(R, 1) = sThk And asTable(R, 2) = sWid Then Exit For
Next R
If asTable(R, 1) <> sThk Or asTable(R, 2) <> sWid Then Stop
'fix?
Set ohFactorySheet = oFactory.ExcelWorkSheet
Set obFactoryBook = ohFactorySheet.Parent
Debug.Print " Opened worksheet: " & Format(Now(), "hh:mm:ss")
ohFactorySheet.Cells(R + 1, 3).Value = sLen 'negligible time
Debug.Print " Edited worksheet: " & Format(Now(), "hh:mm:ss")
obFactoryBook.Save 'do we have to??, doesn't take very long
Debug.Print " Saved worksheet: " & Format(Now(), "hh:mm:ss")
excel.Application.DisplayAlerts = False
Application.DisplayAlerts = False
Debug.Print "turned off alerts...?"
obFactoryBook.Close 'this has problems with balsa factory...
Application.DisplayAlerts = True
excel.Application.DisplayAlerts = True
Debug.Print "turned on alerts...?"
'can we do something else?
Debug.Print " Closed worksheet: " & Format(Now(), "hh:mm:ss")
Call oIpart.ChangeRow(R) '~5 sec, potentially custom parameters in this???
Debug.Print " Edited iPart: " & Format(Now(), "hh:mm:ss")
End If
'for anything that had fixes, need to update and save
oDoc.Update 'this is what takes a long time
Debug.Print " Updated doc: " & Format(Now(), "hh:mm:ss")
oDoc.Save 'quite quick?
Debug.Print " Saved doc: " & Format(Now(), "hh:mm:ss")
NextFile:
'logging
'Set owLogBook = Workbooks.Open("\\mkecomp1\data\SALES FOLDER\TRANSFER FILES\NJT-Sales Transfer\PROJECTS\Engineering\iParts\" & sLogFilename)
'Set ocLogCells = owLogBook.Sheets(1).Cells
ocLogCells(L, 1).Value = oDoc.DisplayName
ocLogCells(L, 2).Value = Format(Now(), "hh:mm:ss")
owLogBook.Save
L = L + 1
oDoc.Close
Debug.Print " Closed doc: " & Format(Now(), "hh:mm:ss")
DoEvents
sFile = Dir
Loop
owLogBook.Close
Call fnPubRoutineExit
End Sub
Sub sciPartSurvey()
'nathan tonkinson 2/8/18
'to see how many components need updating
Dim sFile As String
Const sPath As String = "\\MKECOMP1\data\Eng Docs\Engineering Data\Core Kits, CNC Programs\_Closeout\"
Dim oDoc As Document
Dim oIpart As iPartMember
Dim oWb As Workbook
Dim oCells As Range
Dim I As Integer
Set oWb = Workbooks.Open("C:\users\ntonkinson\desktop\testexcel.xlsx")
Set oCells = oWb.Sheets(1).Cells
I = 2
'load/fix components
sFile = Dir(sPath & "*.ipt*")
Do Until sFile = ""
Set oDoc = ThisApplication.Documents.Open(sPath & sFile, False)
If oDoc.ComponentDefinition.IsiPartMember = False Then GoTo NextFile
Set oIpart = oDoc.ComponentDefinition.iPartMember
If oIpart.CustomMember = False Then GoTo NextFile
If oIpart.HealthStatus = kUpToDateHealth _
Or oDoc.RequiresUpdate = False _
Or oDoc.RecentChanges = 0 Then GoTo NextFile
oCells(I, 1).Value = oIpart.Name
oCells(I, 2).Value = oIpart.HealthStatus
oCells(I, 3).Value = oDoc.RequiresUpdate
oCells(I, 4).Value = oDoc.RecentChanges
I = I + 1
Debug.Print oIpart.Name
Call oWb.Save
NextFile:
oDoc.Close
DoEvents
sFile = Dir
Loop
Call oWb.Save
Call oWb.Close
End Sub