Private Sub Main Dim oAsm As AssemblyDocument=Nothing Dim oPart As PartDocument=Nothing Dim oCD As ComponentDefinition If ThisDoc.Document.DocumentType = kPartDocumentObject Then oPart= ThisDoc.Document oCD = oPart.ComponentDefinition ElseIf ThisDoc.Document.DocumentType = kAssemblyDocumentObject Then oasm = ThisDoc.Document 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 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.",,"iLogic BoxDimensions") Exit Sub End If dX = Round(dX * 10, 0) dY = Round(dY * 10, 0) dZ = Round(dZ * 10, 0) dV = Round(dV, 2) fV = 10 ^ Round(Log(dV) / Log(10) - 2.5) dV = Round(dV / fV) * fV sBox = dX & " x " & dY & " x " & dZ sV = System.String.Format(dV, "0") If ThisDoc.Document.DocumentType = 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,,"iLogic BoxDimensions") ElseIf ThisDoc.Document.DocumentType = kAssemblyDocumentObject Then Call SetPropertyValue(oAsm.PropertySets(4), "xyz-Box", sBox) MsgBox ("xyz-Box in mm:" & vbTab & sBox,,"iLogic BoxDimensions") End If If (ThisDoc.Document.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 oFP = oPart.ComponentDefinition.FlatPattern Try 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 MsgBox ("Halbzeug:" & vbTab & sHalbzeug & _ vbCrLf & "Zuschnitt:" & vbTab & sZuschnitt,,"iLogic BoxDimensions") Call SetPropertyValue(oPart.PropertySets(4), "Halbzeug", sHalbzeug) Call SetPropertyValue(oPart.PropertySets(4), "Zuschnitt", sZuschnitt) Catch MsgBox("Die Werte für Halbzeug und Zuschnitt können nicht aktualisiert werden, da keine Abwicklung vorhanden ist.", , "iLogic BoxDimensions") End Try End If End Sub Private Sub SetPropertyValue(oPropset As PropertySet, sName As String, sValue As String) Try oPropset.Add(sValue,sName) Catch If oPropset.Item(sName).Value <> sValue Then oPropset.Item(sName).Value = sValue End If End Try End Sub