Selection with Picklist

j_weber — Tue, 01 Oct 2024 08:21:56 GMT

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

Hi all,
I have developed a code that allows me to add a tolerance to measurements. However, you must first select the measurements and then execute the macro.
I want to expand it so that you can start the macro, select the measurements, and continue in the macro.
I have seen this somewhere, but unfortunately, I can no longer find the post.
Maybe you could help me there.
I'm no real programmer, so the code probably looks simple.

Betreff: Selection with Picklist

j_weber — Tue, 01 Oct 2024 10:59:56 GMT

I found it by myself

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

End with ECS is okay, but End Selection with Return would be better.

But it is ok, and that is what I want.

topic Selection with Picklist in Inventor Programming Forum

Selection with Picklist

Betreff: Selection with Picklist