请教：过滤语法好像没错，为什么选择集里没对象呢？

junhua1123

Dim Pt1 As Variant
Dim Pt2 As Variant
EntObj(0).GetBoundingBox Pt1, Pt2

'创建选择集
Dim ssetObj As AcadSelectionSet
Set ssetObj = ThisDrawing.SelectionSets("SSET")
If Err Then Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")
ssetObj.Clear

'设置图层过滤

    Dim gpCode(0) As Integer
    Dim dataValue(0) As Variant
    gpCode(0) = 8
    dataValue(0) = "dgx"

'选择与该直线相交或者包含在外框中的所有实体
ssetObj.Select acSelectionSetCrossing, Pt1, Pt2, gpCode, dataValue

jxh2003zfr

1.你这一段是完整代码吗？没见到EntObj(0)的值，没见到错误处理
2.确认层dgx中与该直线有相交的物体。

2. Public Sub mx()
3.     Dim Pt1 As Variant
4.     Dim Pt2 As Variant
5.     Dim ssEnt As AcadSelectionSet
6.     Dim EntObj(0) As AcadEntity
7.     On Error Resume Next
8.     Set ssEnt = ThisDrawing.SelectionSets.Add("ssEnt")
9.     ssEnt.SelectOnScreen
10.     Set EntObj(0) = ssEnt.Item(0)
11.     ssEnt.Clear: ssEnt.Delete
12.     EntObj(0).GetBoundingBox Pt1, Pt2
13.    
14.     Dim ssetObj As AcadSelectionSet
15.     Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")
16.     ssetObj.Clear
18.     Dim gpCode(0) As Integer
19.     Dim dataValue(0) As Variant
20.     gpCode(0) = 8
21.     dataValue(0) = "1"
23. ssetObj.Select acSelectionSetCrossing, Pt1, Pt2, gpCode, dataValue
24. ssetObj.Clear
25. ssetObj.Delete
26. End Sub

Public Sub mx()     Dim Pt1 As Variant     Dim Pt2 As Variant     Dim ssEnt As AcadSelectionSet     Dim EntObj(0) As AcadEntity     On Error Resume Next     Set ssEnt = ThisDrawing.SelectionSets.Add("ssEnt")     ssEnt.SelectOnScreen     Set EntObj(0) = ssEnt.Item(0)     ssEnt.Clear: ssEnt.Delete     EntObj(0).GetBoundingBox Pt1, Pt2         Dim ssetObj As AcadSelectionSet     Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")     ssetObj.Clear     Dim gpCode(0) As Integer     Dim dataValue(0) As Variant     gpCode(0) = 8     dataValue(0) = "1" ssetObj.Select acSelectionSetCrossing, Pt1, Pt2, gpCode, dataValue ssetObj.Clear ssetObj.Delete End Sub

junhua1123

谢谢了，搞定！