Hallo,
ich habe ein VBA Skript, das folgendermaßen aussieht:
Sub iProperties()
'Setze eine Referenz zum Bauteil
Dim oPartDoc As PartDocument
Set oPartDoc = ThisApplication.ActiveDocument
'Physikalische Eigenschaften definieren
Dim oMassProps As MassProperties
Set oMassProps = oPartDoc.ComponentDefinition.MassProperties
'Genauigkeit = hoch
oMassProps.Accuracy = k_High
On Error Resume Next
'Gewicht merken und Runden
realmass = (Round(oMassProps.Mass, 3))
realmassvalue = (Round(oMassProps.Mass, 3))
'Flaeche merken und Runden
realarea = (Round(oMassProps.Area, 1))
realareavalue = (Round(oMassProps.Area, 1))
'Material lesen
Dim oPropsets As PropertySets
Set oPropsets = oPartDoc.PropertySets
Dim oPropmaterial As Property
Set oPropmaterial = oPropsets.Item("{32853F0F-3444-11d1-9E93-0060B03C1CA6}") _
.ItemByPropId(kMaterialDesignTrackingProperties)
Dim oPropmaterial_name As String
oPropmaterial_name = oPropmaterial.Value
'PROPERTIES SCHREIBEN (USER)
Dim oPropSet As PropertySet
Set oPropSet = oPropsets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
'Wenn vorhanden dann löschen
oPropSet.Item("GEWICHT").Delete
oPropSet.Item("FLAECHE").Delete
oPropSet.Item("WERKSTOFF").Delete
'Neu schreiben
Call oPropSet.Add(realmass, "Gewicht", 105)
Call oPropSet.Add(realarea, "Fläche", 106)
Call oPropSet.Add(oPropmaterial_name, "Werkstoff", 108)
On Error GoTo 0
End Sub
Fläche, Werkstoff und Gewicht werden eingetragen. Leider speichert er nicht die neuen iProperties (Datei speichern, schließen und neu öffnen).
Kann das mal einer von euch testen? Und was kann man dagegen tun?
Falls jemand noch eine andere Frage beantworten kann: Ich möchte die Fläche als ganze Zahl gerundet haben. Egal welchen Wert (hier ist es "1") ich bei:
realarea = (Round(oMassProps.Area, 1))
realareavalue = (Round(oMassProps.Area, 1))
eintrage, da tut sich auch nichts bei mir bzw. keine Änderung!
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
