Schwerpunkt in benutzerdefinierte iProperties schreiben (Zeichnung)

leoow96 · ‎10-09-2022

Hallo zusammen,

ich will mir auf einer Zeichnung den Schwerpunkt meines Bauteils ausgeben lassen. Im Bauteil funktioniert soweit meine Regel nach folgendem Beitrag:

https://forums.autodesk.com/t5/inventor-deutsch/ilogic-wenn-ipt-volumen-dann-sonst-mache-nichts/m-p/...

Ich wollte aber die Regel in meiner Zeichnung einfügen und jeweils den Schwerpunkt des momentanen aktiven Modells wiedergeben.

Hier mein Code dazu:

Try

Dim modelDoc = ThisDrawing.ModelDocument
	
centerPt = iProperties.CenterOfGravityOfComponent(modelDoc)

cx = centerPt.X
cy = centerPt.Y
cz = centerPt.Z 

If iProperties.Value("Custom", "X_Schwerpunkt") <> (Round(cx, 8)) Then iProperties.Value("Custom", "X_Schwerpunkt") = (Round(cx, 8))
If iProperties.Value("Custom", "Y_Schwerpunkt") <> (Round(cy, 8)) Then iProperties.Value("Custom", "Y_Schwerpunkt") = (Round(cy, 8))
If iProperties.Value("Custom", "Z_Schwerpunkt") <> (Round(cz, 8)) Then iProperties.Value("Custom", "Z_Schwerpunkt") = (Round(cz, 8))

Catch

End Try

Die Regel läuft ohne Fehlermeldungen durch, jedoch wird nicht in die benutzerdefinierten iProperties geschrieben.

Weiß jemand woran das liegen könnte?

Grüße

Leo

BM_Ashraf · ‎10-10-2022

Hallo,

Probieren Sie diese Regel aus !

'Done by MechDS 
'Email:[email protected] 

If ThisApplication.ActiveDocumentType <> kDrawingDocumentObject Then
	MsgBox("Only for Drawing Document", MsgBoxStyle.OkOnly+MsgBoxStyle.Critical, "MechDS")	
   Exit Sub
End If

Dim oDrawDoc As DrawingDocument= ThisApplication.ActiveDocument

Dim oFD As FileDescriptor= oDrawDoc.File.ReferencedFileDescriptors.Item(1)

On Error Resume Next 
Dim oRefDoc As Document = ThisApplication.Documents.ItemByName(oFD.FullFileName)
If oRefDoc Is Nothing Then 
   MsgBox(oFD.FullFileName & "is not Found", MsgBoxStyle.OkOnly, "Ref Doc")	
   Exit Sub
End If 
Dim oCompDef As ComponentDefinition= oRefDoc.ComponentDefinition
'Get the Center of Mass.
Dim oCenterOfMass As Point = oCompDef.MassProperties.CenterOfMass

Dim oX As Double = Round(oCenterOfMass.X * 10, 8)
Dim oY As Double = Round(oCenterOfMass.Y * 10, 8)
Dim oZ As Double = Round(oCenterOfMass.Z * 10, 8)

'Get the existing property, if it exists.
Dim CustomPropSet As PropertySet= oDrawDoc.PropertySets.Item("Inventor User Defined Properties")

Dim oPropX As [Property]
On Error Resume Next
  oPropX = CustomPropSet.Item("X_Schwerpunkt")
If oPropX Is Nothing Then
   oPropX = CustomPropSet.Add(oX, "X_Schwerpunkt")
Else
oPropX.value = oX
End If

Dim oPropY As [Property]
On Error Resume Next
 oPropY = CustomPropSet.Item("Y_Schwerpunkt")
If oPropY Is Nothing Then
    oPropY = CustomPropSet.Add(oY, "Y_Schwerpunkt")
Else
oPropY.value = oY
End If

Dim oPropZ As [Property]
On Error Resume Next
 oPropZ = CustomPropSet.Item("Z_Schwerpunkt")
If oPropZ Is Nothing Then
    oPropZ = CustomPropSet.Add(oZ, "Z_Schwerpunkt")
Else
oPropZ.value = oZ
End If

MsgBox("X_Schwerpunkt = " & oX & vbNewLine & "Y_Schwerpunkt = " & oY & vbNewLine & _
"Z_Schwerpunkt = " & oZ , MsgBoxStyle.OkOnly+MsgBoxStyle.Information, "MechDS")