选择集应用一例

兰州人

只选择Dimension的图元.
    Dim fType(0) As Integer, fData(0) As Variant
     fType(0) = 0: fData(0) = "DIMENSION"
     sSet.Select acSelectionSetAll, , , fType, fData

2. Sub ls()
3.   Dim objDim As AcadDimension
4.   Dim sSet As AcadSelectionSet
5.   With ThisDrawing
6.      On Error Resume Next
7.      If Not IsNull(.SelectionSets.Item("MySetSelectionSet")) Then
8.        Set sSet = .SelectionSets.Item("MySetSelectionSet")
9.        CreateSelectionSet.Delete
10.      End If
11.      Set sSet = .SelectionSets.Add("MySetSelectionSet")
12.      Dim fType(0) As Integer, fData(0) As Variant
13.      fType(0) = 0: fData(0) = "DIMENSION"
14.      sSet.Select acSelectionSetAll, , , fType, fData
15.   End With
16.   With sSet
17.     For ii = 0 To .Count - 1
18.       Set objDim = .Item(ii)
19.       With objDim
20.         .LinearScaleFactor = 10
21.         .Layer = "尺寸线"
22.       End With
23.       
24.     Next ii
25.   End With
26. End Sub

Sub ls()   Dim objDim As AcadDimension   Dim sSet As AcadSelectionSet   With ThisDrawing      On Error Resume Next      If Not IsNull(.SelectionSets.Item("MySetSelectionSet")) Then        Set sSet = .SelectionSets.Item("MySetSelectionSet")        CreateSelectionSet.Delete      End If      Set sSet = .SelectionSets.Add("MySetSelectionSet")      Dim fType(0) As Integer, fData(0) As Variant      fType(0) = 0: fData(0) = "DIMENSION"      sSet.Select acSelectionSetAll, , , fType, fData   End With   With sSet     For ii = 0 To .Count - 1       Set objDim = .Item(ii)       With objDim         .LinearScaleFactor = 10         .Layer = "尺寸线"       End With            Next ii   End With End Sub

事后诸葛

好例子

542392339

zjh274

这个例子很好，谢谢楼主。

yg545france

楼主能解释一下这段代码的功能吗

yg545france

明白了，找到标注对象，放到尺寸线层里去