So, das funktioniert jetzt für Lineare Maße, also keine Winkelbemaßung etc.
Bei Bedarf kannst es ja noch erweitern.
Sub Selektieren()
Dim odoc As Document
Set odoc = ThisApplication.ActiveDocument
If odoc.DocumentType <> kDrawingDocumentObject Then
MsgBox "Dieses Makro kann nur in Zeichnungen angewendet werden"
Exit Sub
End If
Dim oDrawdoc As DrawingDocument
Dim oselect As SelectSet
Dim oLine As ObjectCollection
Dim oDimension As LinearGeneralDimension
Set oLine = ThisApplication.TransientObjects.CreateObjectCollection
Set oDrawdoc = odoc
Set oselect = oDrawdoc.SelectSet
For i = 1 To oselect.Count
If oselect.Item(i).Type = kLinearGeneralDimensionObject Then
Set oDimension = oselect.Item(i)
Call oLine.Add(oDimension.IntentOne.Geometry.Segments.Item(1))
Call oLine.Add(oDimension.IntentTwo.Geometry.Segments.Item(1))
End If
Next
oDrawdoc.SelectSet.Clear
Call oDrawdoc.SelectSet.SelectMultiple(oLine)
End Sub
Grüße DanSolo
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP