---

Hallo zusammen,

ist es möglich über ein Makro die Dokumenteinheiten zu bearbeiten.

ich möchte unsere Masseneinheit von Kg in g umändern. das natürlich per Makro da wir sonst nie fertig werden :-)

Danke schonmal :-)

Gruß Pete

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

---

Das ist unser Makro mit dem wir ggf. ALLE Einheiten auf unseren Standard bringen:

Code:

---

'***********************************************************************
'          *** "Masseneinheiten" ***
'  kontrolliert die Einstellungen für die Masse-Eigenschaften
'  Version: 1.0    07.06.2010
'  Historie:
'***********************************************************************
Public swApp As SldWorks.SldWorks
Public ModelDoc As SldWorks.ModelDoc2
Public swDocExt As SldWorks.ModelDocExtension
Public swMass As SldWorks.MassProperty
Dim parttype As Variant
Dim test As String

Sub main()
    Set swApp = CreateObject("SldWorks.Application")
    Set ModelDoc = swApp.ActiveDoc
   
    Set swDocExt = ModelDoc.Extension
   
    ' Prüfen, ob es sich um ein Part / asm handelt / check, if the doc is a part
    parttype = ModelDoc.GetType()
    If Not (parttype = 1 Or parttype = 2) Then
        MsgBox "Tut mir leid, das funktioniert nur bei Modellen."
        Exit Sub
    End If
           
            ' Testen auf Einheiten-System, sonst setzen auf Benutzerdefiniert
            test = swDocExt.GetUserPreferenceInteger(swUnitSystem, swDetailingNoOptionSpecified)
            If test <> swUnitSystem_Custom Then
                'result = MsgBox("swUnitSystem: " + Str(test), vbOKOnly, "Testausgabe")
                'result = MsgBox("Einheiten-System ist falsch gesetzt!", vbOKOnly, "Fehlerhafte Einstellung")
                test = swDocExt.SetUserPreferenceInteger(swUnitSystem, swDetailingNoOptionSpecified, swUnitSystem_Custom)
            End If
                       
           
            ' Testen auf Grundeinheit Länge, sonst setzten auf mm
            test = swDocExt.GetUserPreferenceInteger(swUnitsLinear, swDetailingNoOptionSpecified)
            If test <> swMM Then
                'result = MsgBox("swUnitsLinear: " + Str(test), vbOKOnly, "Testausgabe")
                'result = MsgBox("Masse-Eigenschaft Länge ist falsch gesetzt!", vbOKOnly, "Fehlerhafte Einstellung")
                test = swDocExt.SetUserPreferenceInteger(swUnitsLinear, swDetailingNoOptionSpecified, swMM)
            End If
           
            ' Testen auf Grundeinheit Doppelmaß-Länge, sonst setzten auf Zoll
            test = swDocExt.GetUserPreferenceInteger(swUnitsDualLinear, swDetailingNoOptionSpecified)
            If test <> swINCHES Then
                'result = MsgBox("swUnitsDualLinear: " + Str(test), vbOKOnly, "Testausgabe")
                'result = MsgBox("Masse-Eigenschaft Länge ist falsch gesetzt!", vbOKOnly, "Fehlerhafte Einstellung")
                test = swDocExt.SetUserPreferenceInteger(swUnitsDualLinear, swDetailingNoOptionSpecified, swINCHES)
            End If
           
            ' Testen auf Masse-Einheit Länge, sonst setzten auf cm
            test = swDocExt.GetUserPreferenceInteger(swUnitsMassPropLength, swDetailingNoOptionSpecified)
            If test <> swCM Then
                'result = MsgBox("swUnitsMassPropLenth: " + Str(test), vbOKOnly, "Testausgabe")
                'result = MsgBox("Masse-Eigenschaft Länge ist falsch gesetzt!", vbOKOnly, "Fehlerhafte Einstellung")
                test = swDocExt.SetUserPreferenceInteger(swUnitsMassPropLength, swDetailingNoOptionSpecified, swCM)
            End If
                       
            ' Testen auf Masse-Einheit Gewicht, sonst setzen auf kg
            test = swDocExt.GetUserPreferenceInteger(swUnitsMassPropMass, swDetailingNoOptionSpecified)
            If test <> swUnitsMassPropMass_Kilograms Then
                'result = MsgBox("swUnitsMassPropMass: " + Str(test), vbOKOnly, "Testausgabe")
                'result = MsgBox("Masse-Eigenschaft Gewicht ist falsch gesetzt!", vbOKOnly, "Fehlerhafte Einstellung")
                test = swDocExt.SetUserPreferenceInteger(swUnitsMassPropMass, swDetailingNoOptionSpecified, swUnitsMassPropMass_Kilograms)
            End If
           
            ' Testen auf Masse-Einheit Volumen, sonst setzen auf cm³
            test = swDocExt.GetUserPreferenceInteger(swUnitsMassPropVolume, swDetailingNoOptionSpecified)
            If test <> swUnitsMassPropVolume_Centimeters3 Then
                'result = MsgBox("swUnitsMassPropVolume: " + Str(test), vbOKOnly, "Testausgabe")
                'result = MsgBox("Masse-Eigenschaft Volumen ist falsch gesetzt!", vbOKOnly, "Fehlerhafte Einstellung")
                test = swDocExt.SetUserPreferenceInteger(swUnitsMassPropVolume, swDetailingNoOptionSpecified, swUnitsMassPropVolume_Centimeters3)
            End If
                       
        ' Dirty-Flag setzten
        ModelDoc.SetSaveFlag
   
End Sub

---

Die Einheiten selber aber bei Bedarf noch anpassen  .

------------------
Gruß Stefan

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

---

Funktioniert super!!

Vielen Dank :-)

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