Selection with Picklist

[j_weber]

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.  

[j_weber]

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.  

[j_weber · Accepted solution]

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. 

[j_weber · Accepted solution]

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.