Abmaße von Baugruppen (Autodesk/Inventor)

iProperties.BoxDimensions.Small.zip

Moin!

Eine fertige Funktion dafür gibt es in der Standard-Bedien-Oberfläche meines Wissens nicht, aber es geht mit einem kleinen VBA-Programm, das man sich allerdings selber installieren muss. Unten der Code, den ich benutze; er funktioniert sowohl für Baugruppen als auch für Einzelteile. Er stammt aus dem Forum hier, und ich habe ihn angepasst.
Er ist nicht perfekt. Zu beachten ist:

1. Die Abmessungen werden immer nur entlang der Ursprungsachsen gemessen; es wird eine quaderförmige und achsparallele Hüllbox ermittelt. Bei schräg im Raum liegeden Bauteilen kann das schwer verständliche Werte ergeben, aber man weiß dann zumindest die Größenordnung von dem Ding.

2. Die Werte erscheinen immer in der Reihenfolge x - y - z, egal was davon man nach Augenschein "Länge", "Breite" oder "Höhe" nennen würde.

3. Die Genauigkeit ist begrenzt. Je nach Form, besonders bei Rundungen, können um ein paar Zehntel andere Werte erscheinen als z .B. in der idw angegeben würden, wo genauer gerechnet wird.

4. Sichtbare Arbeitselemente werden mitgerechnet. Die Darstellungen von Punkten, Ebenen und Achsen, die meistens das Modell überragen, sollte man also tunlichst vor dem Starten des Moduls ausschalten.

5. Die schließlich vorgenommene Eintragung in den iProperties wird nicht automatisch aktualisiert. Nach Änderungen muss man den Code erneut ausführen.

Wahrscheinlch kann man das auch noch verbessern und automatisieren, aber dazu war mir bisher noch nicht langweilig genug.

[Icon später ergänzt.]

Code:
Sub BoxDimensions()
   Dim oCD As ComponentDefinition
   If ThisApplication.ActiveDocumentType = kPartDocumentObject Then
Dim oPart As PartDocument
Set oPart = ThisApplication.ActiveDocument
Set oCD = oPart.ComponentDefinition
   ElseIf ThisApplication.ActiveDocumentType = kAssemblyDocumentObject Then
Dim oAsm As AssemblyDocument
Set oAsm = ThisApplication.ActiveDocument
Set oCD = oAsm.ComponentDefinition
Else
Exit Sub
End If

Dim dX As Double
Dim dY As Double
Dim dZ As Double
Dim dV As Double
' Dim fx As Double
' Dim fy As Double
' Dim fz As Double
Dim fV As Double
Dim sBox As String
Dim sV As String
dX = oCD.RangeBox.MaxPoint.X - oCD.RangeBox.MinPoint.X
dY = oCD.RangeBox.MaxPoint.Y - oCD.RangeBox.MinPoint.Y
dZ = oCD.RangeBox.MaxPoint.z - oCD.RangeBox.MinPoint.z
dV = oCD.MassProperties.Volume
If dV = 0 Then
MsgBox "xyz-Box kann nicht bestimmt werden, weil kein Volumen vorhanden ist."
Exit Sub
End If
dX = Round(dX * 10, 0)
dY = Round(dY * 10, 0)
dZ = Round(dZ * 10, 0)
dV = Round(dV, 2)

'   fx = 10 ^ Round(Log(dX) / Log(10) - 3)
'   fy = 10 ^ Round(Log(dY) / Log(10) - 3)
'   fz = 10 ^ Round(Log(dz) / Log(10) - 3)
   fV = 10 ^ Round(Log(dV) / Log(10) - 2.5)
'   dX = Round(dX / fx) * fx
'   dY = Round(dY / fy) * fy
'   dz = Round(dz / fz) * fz
   dV = Round(dV / fV) * fV
sBox = dX & " x " & dY & " x " & dZ
sV = Format(dV, "0.0")

If ThisApplication.ActiveDocumentType = kPartDocumentObject Then
   Call SetPropertyValue(oPart.PropertySets(4), "xyz-Box", sBox)
   Call SetPropertyValue(oPart.PropertySets(4), "cm³", sV)
   MsgBox "xyz-Box in mm:" & vbTab & sBox & vbCrLf & "Volumen in cm³:" & vbTab & dV
ElseIf ThisApplication.ActiveDocumentType = kAssemblyDocumentObject Then
Call SetPropertyValue(oAsm.PropertySets(4), "xyz-Box", sBox)
MsgBox "xyz-Box in mm:" & vbTab & sBox
End If

If (ThisApplication.ActiveDocument.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}") Then '(Kennung für Blechteile)
Dim dXz As Double
Dim dYz As Double
Dim dZz As Double
Dim oFP As FlatPattern
Dim sHalbzeug As String
Dim sZuschnitt As String
Set oFP = oPart.ComponentDefinition.FlatPattern
On Error Resume Next
dXz = Round((oFP.Body.RangeBox.MaxPoint.X - oFP.Body.RangeBox.MinPoint.X) * 10, 0)
dYz = Round((oFP.Body.RangeBox.MaxPoint.Y - oFP.Body.RangeBox.MinPoint.Y) * 10, 0)
dZz = Round((oFP.Body.RangeBox.MaxPoint.z - oFP.Body.RangeBox.MinPoint.z) * 10, 0)

sHalbzeug = "BL " & dZz
sZuschnitt = dXz & " x " & dYz
If Err Then
MsgBox "Die Werte für Halbzeug und Zuschnitt können nicht aktualisiert werden, da keine Abwicklung vorhanden ist."
Else
MsgBox "Halbzeug:" & vbTab & sHalbzeug & _
vbCrLf & "Zuschnitt:" & vbTab & sZuschnitt
Call SetPropertyValue(oPart.PropertySets(4), "Halbzeug", sHalbzeug)
Call SetPropertyValue(oPart.PropertySets(4), "Zuschnitt", sZuschnitt)
End If
End If

End Sub

------------------
Roland
www.Das-Entwicklungsbuero.de

It's not the hammer - it's the way you hit!

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

speedyPDM CAD APP für Andere, Datenaustausch, Allgemeine Werkzeuge