---

Hallo zusammen

Ich habe ein Reihe Makros erstellt, mit dem ich Bemassungswerte mit wiederkehrenden symmetrischen Toleranzen (z.B. ±0.1, siehe Code) versehen kann.

Code:

---

Option Explicit
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean

Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
boolstatus = Part.EditDimensionProperties2(4, 0.0001, 0, "", "", False, 1, 1, True, 12, 12, "", "", True, "", "", False)
Part.ClearSelection2 True
End Sub

---

Soweit funktioniert das so. Das Unschöne daran ist, dass wenn vor dem Bemassungswert z.B. das Ø-Zeichnen steht (<MOD-DIAM> ),
es diesen Text beim Ausführen des Makros herauslöscht. Der Befehl Part.EditDimensionProperties2 definiert die Bemassungstexte 
(mit den vier "" am Ende der Zeile) neu. Gibt es eine Möglichkeit, diesen Befehl so anzupassen, dass die Bemassungstexte nicht überschrieben werden?

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

---

Moin,

(ohne irgendwas geprüft zu haben): Ich würde versuchen, den bisherigen Bemaßungstext zuvor auszulesen, dann wieder korrekt reinzuschreiben. Ich denke, wo man was schreiben kann, sollte man auch etwas lesen können...

------------------
Einen schönen Gruß von Heiko
• www.dps-software.de • www.dps-akademie.de • www.iknow-solidworks.de • www.youtube.de/dpssoftwaregmbh •

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

---

In meinem Fall benötige ich nur den Präfix.
Geht das mit swDispDim.GetText(swDimensionTextPrefix) ?
Wie muss die Befehlsfolge aussehen?

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

---

ich würde die Toleranzen
über das "DimensionTolerance" Objekt mit "SetValues" setzen
dann bleibt die Bemaßung unberührt

Hinweis:
- mit "SetValues2" hab ich es nicht geschafft
- nicht vergessen ModelDoc2.GraphicsRedraw2 aufzurufen, damit die Ändeurng sichtbar wird

------------------
Grüße
Heinz

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

---

Hallo Scratch,

falls das Thema noch aktuell ist:

Dim swApp As Object
Dim ModelDoc As Object
Dim SelectionMgr As SelectionMgr
Dim DispDim As Object
Dim swDim                  As SldWorks.Dimension

Dim i, retval As Long

Const swSelDIMENSIONS = 14

Sub main()

Set swApp = CreateObject("SldWorks.Application")
Set ModelDoc = swApp.ActiveDoc
Set SelectionMgr = ModelDoc.SelectionManager

 
For i = 1 To SelectionMgr.GetSelectedObjectCount
       
        If SelectionMgr.GetSelectedObjectType(i) = swSelDIMENSIONS Then        ' wenn es eine Bemaßung ist
           
            Set DispDim = SelectionMgr.GetSelectedObject3(i)                  ' an die Bemaßung anklinken
            Set swDim = DispDim.GetDimension
                   
            retval = DispDim.GetAlternatePrecision2()
            Call DispDim.SetPrecision2(retval, retval, 1, 3)                  'Dezimalstellen = Mass Doppelmass Tol Doppeltol
            retval = swDim.SetToleranceType(4)
            retval = swDim.SetToleranceValues(0, 0.0001)
           
            retval = DispDim.GetType()                                                  '2=normale Bem. 3= Grad Bem
            If retval = 3 Then Call swDim.SetToleranceValues(0, 3.14159265358979 / 180)  ' Pi/180 = 1 Grad-Tol
           
        End If
Next i

Call ModelDoc.WindowRedraw          ' und einmal den Bildschirm neu zeichnen lassen

End Sub

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

---

Hallo Winni-two

Anhand deinem detaillierten Beispiel hat es tipptopp geklappt, danke!

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