Baugruppen-Gewicht in Excel exportieren (Autodesk/Inventor)

Mit diesem Makro exportierst du die Masse der BG als Parameter

public Sub mass()
Dim oPartDoc As AssemblyDocument
Set oPartDoc = ThisApplication.ActiveDocument
Dim oMassProps As MassProperties
Set oMassProps = oPartDoc.ComponentDefinition.MassProperties
oMassProps.Accuracy = k_Medium
Dim oParams As Parameters
Set oParams = oPartDoc.ComponentDefinition.Parameters
Dim oUserParams As UserParameters
Set oUserParams = oParams.UserParameters
oUserParams.Item("mass").Value = oMassProps.mass
MsgBox "Mass: " & oMassProps.mass & " " & oUserParams.Item("mass").Units
oPartDoc.Update
End Sub

Mit dem Makro übertragst du die Parameter in Excel

Public Sub exportToExcel()
Dim oParams As Parameters
Dim sDocName As String
Dim i As Long
Dim iRow As Long
'Next 3 declarations commented during production.
' Uncomment during development, but need reference to Excel (Tools>References>microsoft Excel 10.0 Object libary
'This way no Reference to Excel required (more stable and Excel version independent
'See also Note: OPEN_EXCEL.
' Dim XL As New Excel.Application
' Dim xlWB As Excel.Workbook
' Dim xlWS As Excel.WorkSheet
Dim XL As Object
Dim xlWB As Object
Dim xlWS As Object

If ThisApplication.ActiveDocumentType <> kAssemblyDocumentObject And _
ThisApplication.ActiveDocumentType <> kPartDocumentObject Then
MsgBox "Only Part or Assymbly document", vbCritical
Exit Sub
End If
Set oParams = ThisApplication.ActiveDocument.ComponentDefinition.Parameters

'Connect to Excel, and create a new Workbook
'Note: OPEN_EXCEL.
Set XL = CreateObject("Excel.Application")
Set xlWB = XL.Workbooks.Add
Set xlWS = xlWB.ActiveSheet
XL.Visible = True

'Write the Header Row
iRow = 1
xlWS.Cells(iRow, 1).Value = "Type"
xlWS.Cells(iRow, 2).Value = "Name"
xlWS.Cells(iRow, 3).Value = "Unit"
xlWS.Cells(iRow, 4).Value = "Equation"
xlWS.Cells(iRow, 5).Value = "Export"
xlWS.Cells(iRow, 6).Value = "Health"

'Some Excel formatting:
'1. Freeze Header row
'2. Header Bold and bigger fontsize
xlWS.Rows("2:2").Select
XL.ActiveWindow.FreezePanes = True
xlWS.Rows("1:1").Select
XL.Selection.Font.Bold = True
With XL.Selection.Font
.Name = "Arial"
.Size = 14
.Bold = True
End With

For i = 1 To oParams.Count
iRow = iRow + 1
Select Case oParams.Item(i).Type
Case kModelParameterObject
xlWS.Cells(iRow, 1).Value = "Model"
Case kUserParameterObject
xlWS.Cells(iRow, 1).Value = "User"
Case kTableParameterObject
xlWS.Cells(iRow, 1).Value = "Table"
End Select
xlWS.Cells(iRow, 2).Value = oParams.Item(i).Name
xlWS.Cells(iRow, 3).Value = oParams.Item(i).Units
xlWS.Cells(iRow, 4).Value = oParams.Item(i).Expression
xlWS.Cells(iRow, 5).Value = oParams.Item(i).ExposedAsProperty

Select Case oParams.Item(i).HealthStatus
Case kDeletedHealth
xlWS.Cells(iRow, 6).Value = "Deleted"
Case kDriverLostHealth
xlWS.Cells(iRow, 6).Value = "Driver Lost"
Case kInErrorHealth
xlWS.Cells(iRow, 6).Value = "In Error"
Case kOutOfDateHealth
xlWS.Cells(iRow, 6).Value = "Out of Date"
Case kUnknownHealth
xlWS.Cells(iRow, 6).Value = "Unknown"
Case kUpToDateHealth
xlWS.Cells(iRow, 6).Value = "Up to Date"
End Select
Next

'Format the entire page so cell contents fit
XL.Cells.Select
XL.Cells.EntireColumn.AutoFit
xlWS.Range("A1").Select

'save this XL document, default to Inventor location and name
sDocName = ThisApplication.ActiveDocument.FullFileName
If sDocName = "" Then
sDocName = "c:\temp\x"
Else
sDocName = Mid(sDocName, 1, Len(sDocName) - 4)
End If
If Dir(sDocName & ".xls") <> "" Then
i = 1
Do While Dir(sDocName & "_" & i & ".xls") <> ""
i = i + 1
Loop
sDocName = sDocName & "_" & i
End If
xlWB.SaveAs FileName:=sDocName

'detach from XL
Set xlWS = Nothing
Set xlWB = Nothing
Set XL = Nothing

End Sub

-----------------------------------------------------------------

Beides aus der Ami Newsgroup "geklaut".

Jetz musst du daraus eines machen und dafür sorgen das nur der Parameter "mass" exportiert wird. der Parameter "mass" muss als benutzerdef. Parameter (fx Knopf) existieren

Ich hab nur den Typ der Var. von PartDoc. auf AssemblyDoc. geändert sonst ist alles so wie es war.

Viel Spass beim umbauen

------------------
Grüsse
Jürgen
www.inventor-faq.de
Autodesk Inventor Certified Expert

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP