sure of course
main code:
Option Explicit
Public oAssDoc As AssemblyComponentDefinition
Public oNames As String
Public k As Integer
Public o As Integer
Public AsMat As New Collection
Public s As String
Public Sub API_Assignment()
'Error Handling
'Dim oDoc As DocumentTypeEnum
'oDoc = ThisApplication.ActiveDocumentType
'If oDoc = 12291 Then
'GoTo Start
' Else
' MsgBox "This Code is only working with assemblies", vbOKOnly, "I N F O R M A T I O N"
'GoTo End
'End If
Start:
Set oAssDoc = ThisApplication.ActiveDocument.ComponentDefinition
'1.Assembly Part Counter
Dim oPartC As Long
oPartC = oAssDoc.Occurrences.Count
'2.File Name Identification
'3.Boundary Box Calculations
'4.Volume Calculations
Dim name As New Collection
Dim DP As String
Dim i As Integer
Dim oAssName As String
oAssName = oAssDoc.Document.DisplayName
Dim oVol As New Collection
Dim oMax(1 To 3) As Double
Dim Max As New Collection
Dim oMin(1 To 3) As Double
Dim Min As New Collection
name.Add oAssName
oVol.Add oAssDoc.MassProperties.Volume
oMax(1) = oAssDoc.RangeBox.MaxPoint.X
oMax(2) = oAssDoc.RangeBox.MaxPoint.Y
oMax(3) = oAssDoc.RangeBox.MaxPoint.Z
Max.Add oMax
oMin(1) = oAssDoc.RangeBox.MinPoint.X
oMin(2) = oAssDoc.RangeBox.MinPoint.Y
oMin(3) = oAssDoc.RangeBox.MinPoint.Z
Min.Add oMin
For i = 1 To oPartC
DP = oAssDoc.Occurrences.Item(i).name
name.Add DP
oVol.Add oAssDoc.Occurrences.Item(i).MassProperties.Volume
oMax(1) = oAssDoc.Occurrences.Item(i).RangeBox.MaxPoint.X
oMax(2) = oAssDoc.Occurrences.Item(i).RangeBox.MaxPoint.Y
oMax(3) = oAssDoc.Occurrences.Item(i).RangeBox.MaxPoint.Z
Max.Add oMax
oMin(1) = oAssDoc.Occurrences.Item(i).RangeBox.MinPoint.X
oMin(2) = oAssDoc.Occurrences.Item(i).RangeBox.MinPoint.Y
oMin(3) = oAssDoc.Occurrences.Item(i).RangeBox.MinPoint.Z
Min.Add oMin
Next
'5.Weight & Material Cost Calculations
Set AsMat = Nothing
For k = 1 To oPartC
oNames = oAssDoc.Occurrences.Item(k).name
UserForm1.Show
Dim oMat As Material
Set oMat = ThisApplication.ActiveDocument.Materials.Item(AsMat.Item(k))
ThisApplication.ActiveDocument.ComponentDefinition.Occurrences.Item(k).Definition.Material = oMat
Dim oDens As Double
oDens = oAssDoc.Occurrences.Item(k).Definition.Material.Density
Dim Mass As New Collection
Mass.Add (oDens * oVol.Item(k)) / 1000
Dim MatValue As New Collection
If AsMat.Item(k) = "Aluminum 6061" Then
MatValue.Add Mass.Item(k) * 2.52
ElseIf AsMat.Item(k) = "Copper, Alloy" Then
MatValue.Add Mass.Item(k) * 1.53
ElseIf AsMat.Item(k) = "Concrete" Then
MatValue.Add Mass.Item(k) * 4.8
ElseIf AsMat.Item(k) = "Copper" Then
MatValue.Add Mass.Item(k) * 8.5
ElseIf AsMat.Item(k) = "Stainless Steel" Then
MatValue.Add Mass.Item(k) * 2.12
End If
Next
'6(1). Export to TXT
'Open "D:\test.txt" For Output As #1
'Print #1, "Names" & " " & " " & "Materials" & " " & " " & "Volumes"
'Print #1, name.Item(1) & " " & " " & "---" & " " & " " & oVol.Item(1)& " " & " " &
'For o = 1 To AsMat.Count
'Print #1, name.Item(o + 1) & " " & AsMat.Item(o) & " " & oVol.Item(o + 1) & " " & Max.Item(o).Item(1) & " " & Max.Item(o).Item(2)
'Next
'Close #1
'6(2). Export to EXCEL
Dim ExcelSheet As Object
Set ExcelSheet = CreateObject("Excel.Sheet")
Dim Message, Title, Default, MyData
Dim oFile As String
Message = "Please Enter File Name"
Title = "Excel File Name"
Default = "New"
MyData = InputBox(Message, Title, Default)
oFile = MyData
ExcelSheet.Application.Visible = True
If ExcelSheet Is Nothing Then
MsgBox "In order to be able to see the results you must install the Microsoft Excel Program in your computer.", vbOKOnly, "I N F O R M A T I O N"
GoTo Fin
End If
Const SheetName = "Imported Data from Inventor"
Dim WorkSheet As Object
Dim WorkBook As Object
Const xlCenter = -4108
Set WorkBook = ExcelSheet.Application.Workbooks.Add
Set WorkSheet = WorkBook.Sheets(1)
WorkSheet.name = SheetName
'WorkSheet.Cells(1, 1).Font.Size = 14
'WorkSheet.Cells(2, 1).Font.Size = 12
'WorkSheet.Cells(1, 1).Value = "MSc Advanced Product Design Engineering & Manufacturing"
'WorkSheet.Cells(1, 1).Value = "Module: Advance CAD/CAM Systems"
'WorkSheet.Cells(2, 1).Value = "Apostolaras Nikolaos Panagiotis"
WorkSheet.Cells(1, 1).Value = "Assembly Name:"
WorkSheet.Cells(2, 1).Value = "Part Counter:"
WorkSheet.Cells(2, 2).Value = oPartC
WorkSheet.Cells(6, 2).Value = "Boundary Box (X,Y,Z points)"
'WorkSheet.Cells(5, 1).Value = "Values and calculations_Components [1:1]"
WorkSheet.Range("B6:G6").Merge
'WorkSheet.Range("A5:K5").Merge
WorkSheet.Cells(6, 2).HorizontalAlignment = xlCenter
WorkSheet.Cells(7, 1).Value = "Part Names"
WorkSheet.Cells(7, 2).Value = "Boundary_Point_Max X"
WorkSheet.Cells(7, 3).Value = "Boundary_Point_Max Y"
WorkSheet.Cells(7, 4).Value = "Boundary_Point_Max Z"
WorkSheet.Cells(7, 5).Value = "Boundary_Point_Min X"
WorkSheet.Cells(7, 6).Value = "Boundary_Point_Min Y"
WorkSheet.Cells(7, 7).Value = "Boundary_Point_Min Z"
WorkSheet.Cells(7, 8).Value = "Material"
WorkSheet.Cells(7, 9).Value = "Volume(cm^3)"
WorkSheet.Cells(7, 10).Value = "Weight(kg)"
WorkSheet.Cells(7, 11).Value = "Material Cost(€)"
WorkSheet.Cells(1, 2).Value = name.Item(1)
WorkSheet.Columns("A:L").EntireColumn.AutoFit
WorkSheet.Columns("A:K").HorizontalAlignment = xlCenter
For i = 1 To oPartC + 1
WorkSheet.Cells(7 + i, 1).Value = name.Item(i)
WorkSheet.Cells(7 + i, 2).Value = Max.Item(i)(1)
WorkSheet.Cells(7 + i, 3).Value = Max.Item(i)(2)
WorkSheet.Cells(7 + i, 4).Value = Max.Item(i)(3)
WorkSheet.Cells(7 + i, 5).Value = Min.Item(i)(1)
WorkSheet.Cells(7 + i, 6).Value = Min.Item(i)(2)
WorkSheet.Cells(7 + i, 7).Value = Min.Item(i)(3)
WorkSheet.Cells(7 + i, 8).Value = oVol.Item(i)
Next
For i = 1 To oPartC + 1
WorkSheet.Cells(8 + i, 9).Value = Mass.Item(i)
WorkSheet.Cells(8 + i, 10).Value = MatValue.Item(i)
WorkSheet.Cells(8 + i, 11).Value = AsMat.Item(i)
Next
Dim FileName As String
FileName = "D:\Data_From_Inventor_" & oFile & ".XLSX"
WorkSheet.SaveAs FileName
MsgBox "The results were saved at : " & FileName, vbOKOnly, "I N F O R M A T I O N"
WorkSheet.Application.Quit
Set WorkSheet = Nothing
Fin:
End Sub
userform code:
Public Sub UserForm_Initialize()
TextBox1.Value = oNames
With Material
.AddItem "Aluminum 6061"
.AddItem "Copper, Alloy"
.AddItem "Concrete"
.AddItem "Copper"
.AddItem "Stainless Steel"
End With
End Sub
Private Sub CommandButton1_Click()
If Material.Value <> "" Then
s = Material.Value
AsMat.Add s
Unload Me
Else
MsgBox "Please select an item to continue", vbCritical, "Error"
End If
End Sub
userform image:
https://imgur.com/3keH96B
