Hallo ihr lieben,
ich habe mir wieder eine kleine Vereinfachung erstellt.
Es gab immer wieder mal das die Anforderung in einer Zeichnung, das bestimmte lineare Maße eine Abmaßtoleranz bekommen soll, also oberes Abmaß und unteres Abmaß.
Bisher musste ich immer in das Maß gehen und dort dann einstelle. Das ist bei viele Maßen Zeitaufwändig.
Also hab ich geschaut, ob man das vereinfachen kann.
Geht auch.
Hier die Codes
VBA:
Sub SetTol()
'Ändert die Toleranz für vorher markierte Maße
'Zugriff auf aktuelle Zeichnung
Dim oDrawing As DrawingDocument
Set oDrawing = ThisApplication.ActiveDocument
'Zugriff auf Zeichnung
Dim osheet As Sheet
Set osheet = oDrawing.ActiveSheet
'Zugriff auf aktives Blatt
Dim oSSet As SelectSet
Set oSSet = oDrawing.SelectSet
'Zugriff auf Bemaßungs in der Zeichnung
Dim oDims As DrawingDimensions
Set oDims = osheet.DrawingDimensions
'Zugriff auf generelle Bemaßungen
Dim oGenDims As GeneralDimensions
Set oGenDims = oDims.GeneralDimensions
'Toleranzwert Oben festlegen
Dim oTolUpper As Double
oTolUpper = InputBox("Geben Sie den oberen Toleranzwert an", "Oberes Abmaß", 0.1)
oTolUpper = oTolUpper / 10
'Toleranzwert unten festlegen
Dim oTolLower As Double
oTolLower = InputBox("Geben Sie den unteren Toleranzwert an", "Unteres Abmaß", -0.2)
oTolLower = oTolLower / 10
Dim oDimSelect As LinearGeneralDimension
For Each oDimSelect In oSSet
Call oDimSelect.Tolerance.SetToDeviation(oTolUpper, oTolLower)
Next
End Sub
iLogic
Dim oDrawing As DrawingDocument
oDrawing = ThisApplication.ActiveDocument
'Zugriff auf Zeichnung
Dim osheet As Sheet
osheet = oDrawing.ActiveSheet
'Zugriff auf aktives Blatt
Dim oSSet As SelectSet
oSSet = oDrawing.SelectSet
'Zugriff auf Bemaßungs in der Zeichnung
Dim oDims As DrawingDimensions
oDims = osheet.DrawingDimensions
'Zugriff auf generelle Bemaßungen
Dim oGenDims As GeneralDimensions
oGenDims = oDims.GeneralDimensions
'Toleranzwert Oben festlegen
Dim oTolUpper As Double
oTolUpper = InputBox("Geben Sie den oberen Toleranzwert an", "Oberes Abmaß", 0.1)
oTolUpper = oTolUpper / 10
'Toleranzwert unten festlegen
Dim oTolLower As Double
oTolLower = InputBox("Geben Sie den unteren Toleranzwert an", "Unteres Abmaß", -0.2)
oTolLower = oTolLower / 10
Dim oDimSelect As LinearGeneralDimension
For Each oDimSelect In oSSet
Call oDimSelect.Tolerance.SetToDeviation(oTolUpper, oTolLower)
Next
Vielleicht kann es ja der eine oder andere verwenden.
Als nächste möchte ich es Versuchen für Passungen bei Bohrungen, also H7 oder so, zu erstellen.
Ich habe es geschafft den Code zu erweitern.
Dim oSet As HighlightSet
If ThisApplication.ActiveDocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then
MsgBox("Es ist keine Zeichnung geöffnet. Bitte öffnen Sie eine Zeichnung")
Exit Sub
Else
MsgBox("Sie befinden sich in einer Zeichnung")
End If
Dim oDrawing As DrawingDocument
oDrawing = ThisApplication.ActiveDocument
oSet = oDrawing.CreateHighlightSet
While True
Dim oDim As Object
oDim = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingDimensionFilter, "Bitte Bemaßung wählen. Auswahl mit ESC beenden")
If IsNothing(oDim) Then Exit While
oSet.AddItem(oDim)
End While
'Zugriff auf Zeichnung
Dim osheet As Sheet
osheet = oDrawing.ActiveSheet
'Zugriff auf aktives Blatt
'Dim oSSet As SelectSet
'oSSet = oDrawing.SelectSet
'Zugriff auf Bemaßungs in der Zeichnung
Dim oDims As DrawingDimensions
oDims = osheet.DrawingDimensions
'Zugriff auf generelle Bemaßungen
Dim oGenDims As GeneralDimensions
oGenDims = oDims.GeneralDimensions
'Toleranzwert Oben festlegen
Dim oTolUpper As Double
oTolUpper = InputBox("Geben Sie den oberen Toleranzwert an", "Oberes Abmaß", 0.1)
oTolUpper = oTolUpper / 10
'oTolUpper = 0.01
'Toleranzwert unten festlegen
Dim oTolLower As Double
oTolLower = InputBox("Geben Sie den unteren Toleranzwert an", "Unteres Abmaß", -0.2)
oTolLower = oTolLower / 10
'oTolLower = -0.02
Dim oDimSelect As LinearGeneralDimension
For Each oDimSelect In oSet
Call oDimSelect.Tolerance.SetToDeviation(oTolUpper, oTolLower)
Next
Jetzt kann man die Regel starten, die Maße auswählen die eine Toleranz erhalten sollen, die Auswahl mit ESC beenden und dann wird der Code weiter ausgeführt.
Auswahlabschluss mit Enter wäre mir lieber, mal sehen ob ich das auch noch finde.
Aber so geht es schon mal ohne erst die Maße auszuwählen und dann den Code auszuführen.
Ist erst einmal iLogic, VBA will das While nicht so richtig.
Hallo Michael,
Toleranzen werden nicht in der Skizze am Maß vergeben, sondern über die Parameterliste.
Dort kann man dann einem Maß mitteilen, was für eine Art Toleranz es haben soll.
Das wird bei Modellparameter in der Anzeige Nennwert gemacht, nicht bei Benutzerparameter.
Die Toleranz und den Nennwert ergibt dann den Modellwert.
Wenn Du nicht klar kommst melde ich, dann zeig ich dir das mal
Hallo Michael,
Du hast ja schon richtiger Weise geschrieben, das Du in der Zeichnung Modellmaße angibst.
Diese zeigen Dir dann auch die Toleranzen an.
Nur leider, wenn Du an der Toleranz in der Zeichnung änderst, geht das nicht ins Modell über.
Ich hatte ein ähnliche Frage vor Kurzem und mußte da feststellen, das die Toleranzen nur vom Modell an die Zeichnung übergeben werden.
Leider
Hier hat der Inventor noch Handlungsbedarf.
An Benutzermaßen in der Zeichnung ist es so, das die Toleranzen nur auf der Zeichnung stehen, nicht am Modell.
Persönlich würde ich die Toleranzen am Modellparameter anbringen. Dann steuert es auch das Bauteil wenn man mal eine Toleranzanalyse machen möchte.
