Lueghi Mitglied Admin für alle Systeme ....
Beiträge: 416 Registriert: 01.07.2005 CAD...: SWX2022 SP5, ACAD 2019, Tacton / LINO PDM...: PRO.FILE 8.6 ERP...: proAlpha 6.2e / 7.1 BS....: Win10, HP ZBook G5
|
erstellt am: 14. Jun. 2021 08:37 <-- editieren / zitieren --> Unities abgeben: Nur für Pete85
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 StringSub 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 |