---

Hallo ans Forum,

meine erster Beitrag - gleiche eine Frage.

Ich habe bereits ein Makro zum Setzen der Einheiten auf mm, gr und cm³ - leider finde ich den entsprechenden
Paramter zum Setzen der Dezimalen nicht.
Kann mir jemand weiterhelfen?

Mein bisheriger Code:

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 Variant
   

Sub E()
Set swApp = CreateObject("SldWorks.Application")
    Set ModelDoc = swApp.ActiveDoc
   
    Set swDocExt = ModelDoc.Extension
   
    ' Prüfen, ob es sich um ein Part handelt / check, if the doc is a part
    parttype = ModelDoc.GetType()
    If parttype <> 1 Then
        MsgBox "Tut mir leid, das funktioniert nur bei Teilen"
        Exit Sub
    End If
           
            ' Testen auf Einheiten-System, sonst setzen auf Benutzerdefiniert
            test = swDocExt.GetUserPreferenceInteger(swUnitSystem, swDetailingNoOptionSpecified)
            If test <> swUnitSystem_Custom Then
                test = swDocExt.SetUserPreferenceInteger(swUnitSystem, swDetailingNoOptionSpecified, swUnitSystem_Custom)
            End If
                       
           
            ' Testen auf Masse-Einheit Länge, sonst setzten auf mm
            test = swDocExt.GetUserPreferenceInteger(swUnitsMassPropLength, swDetailingNoOptionSpecified)
            If test <> swMM Then
                test = swDocExt.SetUserPreferenceInteger(swUnitsMassPropLength, swDetailingNoOptionSpecified, swMM)
            End If
           
                       
            ' Testen auf Masse-Einheit Gewicht, sonst setzen auf g
            test = swDocExt.GetUserPreferenceInteger(swUnitsMassPropMass, swDetailingNoOptionSpecified)
            If test <> swUnitsMassPropMass_Grams Then
                test = swDocExt.SetUserPreferenceInteger(swUnitsMassPropMass, swDetailingNoOptionSpecified, swUnitsMassPropMass_Grams)
            End If
           
            ' Testen auf Masse-Einheit Volumen, sonst setzen auf cm³
            test = swDocExt.GetUserPreferenceInteger(swUnitsMassPropVolume, swDetailingNoOptionSpecified)
            If test <> swUnitsMassPropVolume_Centimeters3 Then
                test = swDocExt.SetUserPreferenceInteger(swUnitsMassPropVolume, swDetailingNoOptionSpecified, swUnitsMassPropVolume_Centimeters3)
            End If
End Sub

Vielen Dank bereits jetzt
Stephan

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

---

Guten Morgen,

ich habe gestern noch weiter gesucht und folgenden Parameter gefunden, weiß aber nicht, ob er stimmt und bekomme es auch nicht zum Laufen:

swUnitsMassDecimalPlaces

Den Teil, welchen ich in das Makro noch integrieren würde laut wie folgt:

' Testen auf Masse-Dezimale, sonst setzten auf 2
            test = swDocExt.GetUserPreferenceInteger(swUnitsMassPropDecimalPlaces, swDetailingNoOptionSpecified)
            If test <> swUnitsMassDecimalPlaces_2 Then
                test = swDocExt.SetUserPreferenceInteger(swUnitsMassDecimalPlaces_2, swDetailingNoOptionSpecified)
            End If

Das Makro läuft durch, es ändert aber an den eingestellten Dezimalen nichts.

Hat jemand Erfahrung damit, bin absoluter Neuling bei der Programmierung von Makros.

Besten Dank an Euch
Stephan

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

---

Ich bin nochmals einen Schritt weiter:

Mit

' Testen auf Masse-Dezimale, sonst setzten auf 2
            test = swDocExt.GetUserPreferenceInteger(swUnitsMassPropDecimalPlaces, swDetailingNoOptionSpecified)
            If test <> swUnitsMassPropDecimalPlaces_2 Then
                test = swDocExt.SetUserPreferenceInteger(swUnitsMassPropDecimalPlaces, swDetailingNoOptionSpecified, swUnitsMassPropDecimalPlaces_2)
            End If

Setzt er die Dezimalstellen auf keine.
Leider weiß ich nicht, wie ich auf .12 oder .123 komme.

Kann mir diesen letzten Schritt vll. jemand zeigen?

Besten Dank
Stephan

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

---

Hallo Stephan,

nicht dass du denkst, du mußt hier nur Monologe führen.

Ich habe keine Ahnung von Makros, aber vlt hilft dir das weiter, wenn du deine ganze Prozedur mal händisch durchführst, während du den Makrorekorder im Hintergrund laufen lässt.
Vielleicht kommst du so zu deinen fehlenden Schnipseln.

Ansonsten kommt hier bestimmt noch etwas an Hilfe!

------------------
CSWST/CSWI/CSWP/  3DVia

DPS-Software GmbH When was the last time you did something for the first time?

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

---

ich kann an deinem Schnipsel nicht erkennen, welchen Wert duswUnitsMassPropDecimalPlaces_2 zuweist.

Wenn du dieser Variablen keinen Wert zuweist, wird sie vermutlich den Wert 0 haben - und dann macht die Methode genau das, was du beschreibst - sie setzt die Dezimalstellen auf keine.

An der Stelle. wo du swUnitsMassPropDecimalPlaces_2 stehen hast, muß ein Interger-Wert 0-8 stehen (oder du weist der Variable swUnitsMassPropDecimalPlaces_2 vorher diesen Wert zu) - und dann sollte es klappen.
Mit Wert 3 hast du bspw. 3 Nachkommastellen ...

------------------
mfg uc

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

---

Hallo uc,

hier nochmals das komplete Makro:

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 Variant
   

Sub E()
Set swApp = CreateObject("SldWorks.Application")
    Set ModelDoc = swApp.ActiveDoc
   
    Set swDocExt = ModelDoc.Extension
   
    ' Prüfen, ob es sich um ein Part handelt / check, if the doc is a part
    parttype = ModelDoc.GetType()
    If parttype <> 1 Then
        MsgBox "Tut mir leid, das funktioniert nur bei Teilen"
        Exit Sub
    End If
           
            ' Testen auf Einheiten-System, sonst setzen auf Benutzerdefiniert
            test = swDocExt.GetUserPreferenceInteger(swUnitSystem, swDetailingNoOptionSpecified)
            If test <> swUnitSystem_Custom Then
                test = swDocExt.SetUserPreferenceInteger(swUnitSystem, swDetailingNoOptionSpecified, swUnitSystem_Custom)
            End If
                       
           
            ' Testen auf Masse-Einheit Länge, sonst setzten auf mm
            test = swDocExt.GetUserPreferenceInteger(swUnitsMassPropLength, swDetailingNoOptionSpecified)
            If test <> swMM Then
                test = swDocExt.SetUserPreferenceInteger(swUnitsMassPropLength, swDetailingNoOptionSpecified, swMM)
            End If
           
            ' Testen auf Masse-Dezimale, sonst setzten auf 2
            test = swDocExt.GetUserPreferenceInteger(swUnitsMassPropDecimalPlaces, swDetailingNoOptionSpecified)
            If test <> swUnitsMassPropDecimalPlaces_2 Then
                test = swDocExt.SetUserPreferenceInteger(swUnitsMassPropDecimalPlaces, swDetailingNoOptionSpecified, 5)
            End If
     
                       
            ' Testen auf Masse-Einheit Gewicht, sonst setzen auf g
            test = swDocExt.GetUserPreferenceInteger(swUnitsMassPropMass, swDetailingNoOptionSpecified)
            If test <> swUnitsMassPropMass_Grams Then
                test = swDocExt.SetUserPreferenceInteger(swUnitsMassPropMass, swDetailingNoOptionSpecified, swUnitsMassPropMass_Grams)
            End If
           
            ' Testen auf Masse-Einheit Volumen, sonst setzen auf cm³
            test = swDocExt.GetUserPreferenceInteger(swUnitsMassPropVolume, swDetailingNoOptionSpecified)
            If test <> swUnitsMassPropVolume_Centimeters3 Then
                test = swDocExt.SetUserPreferenceInteger(swUnitsMassPropVolume, swDetailingNoOptionSpecified, swUnitsMassPropVolume_Centimeters3)
            End If
End Sub

kannst Du mir zeigen, wo der Integer- Wert hin muss?

Danke
Stephan

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

---

Ich habe es gelöst, hier das komplette Makro zum Setzen der Einheiten in mm, g und cm³ mit 2 Dezimalen.
UC hat mir den entscheidenen Hinweis gegeben - Unities sind unterwegs!

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 userPref As Integer
Dim userPrefOption As Integer
Dim value As Integer
Dim test As Variant

   

Sub E()
Set swApp = CreateObject("SldWorks.Application")
    Set ModelDoc = swApp.ActiveDoc
   
    Set swDocExt = ModelDoc.Extension
   
    ' Prüfen, ob es sich um ein Part handelt / check, if the doc is a part
    parttype = ModelDoc.GetType()
    If parttype <> 1 Then
        MsgBox "Tut mir leid, das funktioniert nur bei Teilen"
        Exit Sub
    End If
           
            ' Testen auf Einheiten-System, sonst setzen auf Benutzerdefiniert
            test = swDocExt.GetUserPreferenceInteger(swUnitSystem, swDetailingNoOptionSpecified)
            If test <> swUnitSystem_Custom Then
                test = swDocExt.SetUserPreferenceInteger(swUnitSystem, swDetailingNoOptionSpecified, swUnitSystem_Custom)
            End If
                       
           
            ' Testen auf Masse-Einheit Länge, sonst setzten auf mm
            test = swDocExt.GetUserPreferenceInteger(swUnitsMassPropLength, swDetailingNoOptionSpecified)
            If test <> swMM Then
                test = swDocExt.SetUserPreferenceInteger(swUnitsMassPropLength, swDetailingNoOptionSpecified, swMM)
            End If
           
            ' Testen auf Masse-Dezimale, sonst setzten auf 2
            test = swDocExt.GetUserPreferenceInteger(swUnitsMassPropDecimalPlaces, swDetailingNoOptionSpecified)
            If test <> swUnitsMassPropDecimalPlaces_2 Then
                test = swDocExt.SetUserPreferenceInteger(swUnitsMassPropDecimalPlaces, swDetailingNoOptionSpecified, 2)
            End If
     
                       
            ' Testen auf Masse-Einheit Gewicht, sonst setzen auf g
            test = swDocExt.GetUserPreferenceInteger(swUnitsMassPropMass, swDetailingNoOptionSpecified)
            If test <> swUnitsMassPropMass_Grams Then
                test = swDocExt.SetUserPreferenceInteger(swUnitsMassPropMass, swDetailingNoOptionSpecified, swUnitsMassPropMass_Grams)
            End If
           
            ' Testen auf Masse-Einheit Volumen, sonst setzen auf cm³
            test = swDocExt.GetUserPreferenceInteger(swUnitsMassPropVolume, swDetailingNoOptionSpecified)
            If test <> swUnitsMassPropVolume_Centimeters3 Then
                test = swDocExt.SetUserPreferenceInteger(swUnitsMassPropVolume, swDetailingNoOptionSpecified, swUnitsMassPropVolume_Centimeters3)
            End If
End Sub

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