Curtis wrote this and it works wonderfully however it does not like the new 2025.1. It looks like it's trying to call an executable but it's not providing the correct name or something...Any ideas?
Here is the error:
'REV 10 (10/10/23)
'verify document type
If ThisApplication.ActiveDocumentType <> Inventor.DocumentTypeEnum.kAssemblyDocumentObject Then
'MessageBox.Show("Document Type: " & ThisApplication.ActiveDocumentType.ToString)
MessageBox.Show("Must be run from an Assembly! Program will now exit.")
Exit Sub
End If
areaAdder = 1.50 'add % to area calc to account for drop cw
oPath = ThisDoc.WorkspacePath()
oJob = oPath.Substring(oPath.LastIndexOf("\") + 1)
'oLogFile = oPath & "\Material Usage.txt"
oLogFile = oPath & "\" & oJob & "_Material.txt"
'MessageBox.Show(oLogFile)
'uncomment/comment to change suffix format
sSuffix = " sq feet"
'sSuffix = " ft^2"
'sSuffix = " sq inch"
'sSuffix = " in^2"
'uncomment/comment to change conversion factor
oConversion_factor = 929.03 'cm to feet
'oConversion_factor = 6.4516 'cm to inch
'uncomment/comment to change tab spacing in output file
sSpacer = vbTab
'create log file if it does not exist
If System.IO.File.Exists(oLogFile) Then
System.IO.File.Delete(oLogFile)
End If
'create log file
Dim oStreamWriter As System.IO.StreamWriter
oStreamWriter = IO.File.CreateText(oLogFile)
'oStreamWriter.WriteLine(Now())
oStreamWriter.WriteLine("")
oStreamWriter.WriteLine("Totals for ONE unit" & " + " & ((areaAdder - 1) * 100) & "%") 'cw
oStreamWriter.Close()
'[ look at each component
Dim oAssyDoc As AssemblyDocument
oAssyDoc = ThisApplication.ActiveDocument
Dim oAsmCompDef As ComponentDefinition
oAsmCompDef = oAssyDoc.ComponentDefinition
Dim oOcc As ComponentOccurrence
Dim oMatList As New ArrayList
Dim oUniqueList As New ArrayList
Dim oFinalList As New ArrayList
Dim dArea As Double
'iterate through all lowest level occurrences (parts)
For Each oOcc In oAsmCompDef.Occurrences.AllLeafOccurrences
'MessageBox.Show(oOcc.Name)
'if component occurrence is suppressed, skip to next component
If oOcc.Suppressed Then
'MessageBox.Show(oOcc.Name & " supressed")
Continue For
End If
Dim oDoc As PartDocument
oDoc = oOcc.Definition.Document
Dim oUOM As UnitsOfMeasure
oUOM = oDoc.UnitsOfMeasure
'ensure this part is a Sheet Metal Part
If Not oDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}"
'MessageBox.Show("Part is not a Sheet Metal Part: " & oDoc.FullFileName)
Continue For
End If
Dim oDef As SheetMetalComponentDefinition
oDef = oDoc.ComponentDefinition
oMat = oDef.Material
'MessageBox.Show(oMat.Name, "debug")
'Don't skip if certain materials
If Not UCase(oMat.Name) = "CERAMIC TILE" And Not UCase(oMat.Name) = "CBU" And Not UCase(oMat.Name) = "CBUHE" And Not UCase(oMat.Name) = "EMBU" Then
'skip if x
If UCase(iProperties.Value(oOcc.Name, "Summary", "Keywords")) = "X" Then
Continue For
End If
End If
oPrecision = oUOM.LengthDisplayPrecision 'get current precision
oUOM.LengthDisplayPrecision = 4 'set to 4 places
oThick = oDef.Parameters.Item("Thickness").Value
'MessageBox.Show(oThick, "debug")
oThick = oUOM.GetStringFromValue(oThick, "in")
oThick = oThick.Replace(Right(oThick, 3), "") ' remove unit string
oThick = CDblAny(oThick) 'convert back to number
oThick = FormatNumber(oThick, 4, , , TriState.True) ' format
oUOM.LengthDisplayPrecision = oPrecision 'set precision back
'only add to list if it is unique
If Not oUniqueList.Contains(oMat.Name & " " & oThick) Then
oUniqueList.Add(oMat.Name & " " & oThick)
End If
Dim oTransaction As Transaction
oTransaction = ThisApplication.TransactionManager.StartTransaction(oDoc, "Find area")
'create flat pattern if none exist
If oDef.FlatPattern Is Nothing Then
Dim openedView As Inventor.View = Nothing
If oDoc IsNot ThisApplication.ActiveDocument Then
openedView = oDoc.Views.Add()
oDoc.Activate()
End If
Try
'create flat pattern
oDef.Unfold
'close flat pattern
oDef.FlatPattern.ExitEdit
If openedView IsNot Nothing Then
openedView.Close()
End If
Catch
MessageBox.Show("Can't create flat pattern for: " & oDoc.FullDocumentName & vbCr & "Program will now exit.")
Exit Sub
End Try
End If
Dim oFlatPattern As FlatPattern
oFlatPattern = oDef.FlatPattern
Dim oFlatFeatures As FlatPatternFeatures
oFlatFeatures = oFlatPattern.Features
'Create an Object collection To add the features For suppression
Dim oFeatCollection As ObjectCollection
oFeatCollection = ThisApplication.TransientObjects.CreateObjectCollection
For Each oFeat In oFlatFeatures
If oFeat.Suppressed = False Then
'Add feature to suppress to the collection
oFeatCollection.Add(oFeat)
End If
Next
'suppress everything in this collection
Try
oDef.FlatPattern.SuppressFeatures(oFeatCollection)
Catch
End Try
'MessageBox.Show("Debug1")
'[ get area
Try
Dim oSketch As PlanarSketch
oSketch = oFlatPattern.Sketches.Add(oFlatPattern.TopFace)
'MessageBox.Show("Debug1")
Dim oEdgeLoop As EdgeLoop
For Each oEdgeLoop In oFlatPattern.TopFace.EdgeLoops
If oEdgeLoop.IsOuterEdgeLoop Then
Exit For
End If
Next
Dim oEdge As Edge
For Each oEdge In oEdgeLoop.Edges
oSketch.AddByProjectingEntity(oEdge)
Next
Dim oProfile As Profile
oProfile = oSketch.Profiles.AddForSolid
dArea = oProfile.RegionProperties.Area
sArea = Round(dArea, 3) * areaAdder
'MessageBox.Show("oMatlist.Add: " & oDef.Document.FullFileName)
oMatList.Add(oMat.Name & " " & oThick & "|" & sArea)
oTransaction.Abort
Catch
MessageBox.Show("Failed to create sketch: " & oDef.Document.FullFileName & vbCr & oDef.Document.FullDocumentName & vbCr & "Program will now exit.")
Exit Sub
End Try
Next
']
'[ total areas for same materials
Dim dTotal As Double
Dim sName As String
Dim sPartNumber As String
'get max of mat & thickness string
sMatNameLen_Max = 0
For Each sName In oUniqueList
'capture max mat name length
sMatNameLen = Len(sName)
If sMatNameLen > sMatNameLen_Max Then
sMatNameLen_Max = sMatNameLen
End If
Next
'add header dash line calc'd on max mat name length
sDash = "-"
For i = 0 To sMatNameLen_Max + 30 + 10
sDash = sDash & "-"
Next
'amend log file
oStreamWriter = IO.File.AppendText(oLogFile)
oStreamWriter.WriteLine(sDash)
oStreamWriter.Flush()
oStreamWriter.Close()
For Each sName In oUniqueList
For Each oItem in oMatList
'split using char
Dim sMat_Area As String() = oItem.Split(New Char() {"|"c })
sMat = sMat_Area(0)
sArea = sMat_Area(1)
dArea = CDblAny(sArea) 'get number as a double
If sMat = sName Then
dTotal = dTotal + dArea
sTotal = Round(dTotal / oConversion_factor, 3)
sTotal = FormatNumber(sTotal, 3, , , TriState.True) & sSuffix ' format
End If
Next
'Trace.WriteLine(sName, "iLogic") 'debug
'Trace.WriteLine(sMatNameLen_Max, "iLogic") 'debug
'Trace.WriteLine(Len(sName) , "iLogic") 'debug
'calc the number of spaces to add
oNamePad = sMatNameLen_Max - Len(sName)
oPad = ""
For k = 0 To oNamePad
oPad = oPad & " "
Next
'Supply the stock sheet part#
Select Case sName
Case "Steel Mild 0.0747"
sPartNumber = "800003"
Case "Steel Mild 0.1046"
sPartNumber = "800005"
Case "Steel Mild 0.1345"
sPartNumber = "800007"
Case "Steel Mild 0.1875"
sPartNumber = "801001"
Case "Steel Mild 0.2500"
sPartNumber = "801002"
Case "Steel Mild 0.3750"
sPartNumber = "801004"
Case "Steel Mild 0.5000"
sPartNumber = "801005"
Case "Steel Mild 0.6250"
sPartNumber = "801009"
Case "Stainless Steel 0.0747"
sPartNumber = "800303"
Case "Stainless Steel 0.1046"
sPartNumber = "800304"
Case "Stainless Steel 0.1345"
sPartNumber = "800305"
Case "Stainless Steel 0.1875"
sPartNumber = "801101"
Case "Stainless Steel 0.2500"
sPartNumber = "801103"
Case "Stainless Steel 0.3750"
sPartNumber = "801104"
Case "AR 0.1345"
sPartNumber = "802510"
Case "AR 0.1875"
sPartNumber = "802502"
Case "AR 0.2500"
sPartNumber = "802504"
Case "Galvanized 0.1046"
sPartNumber = "800152"
Case "CBU 0.2500"
sPartNumber = "800511"
Case "CBUHE 0.2500"
sPartNumber = "800523"
Case "EMBU 0.2500"
sPartNumber = "800509"
Case "CERAMIC TILE 0.2500"
sPartNumber = "HEX:800600 4X6:800602"
Case Else
sPartNumber = "xxxxxx"
End Select
'amend log file
oMessageLine1 = sName & oPad & " (" & sPartNumber & ")" & sSpacer & ":" & sSpacer & sTotal
oStreamWriter = IO.File.AppendText(oLogFile)
oStreamWriter.WriteLine(oMessageLine1)
oStreamWriter.Flush()
oStreamWriter.Close()
dTotal = 0
Next
Process.Start(oLogFile)
']
