CAD窗选时，人机交互中窗选特定类型图元，可使用选择集+过滤器实现，如下图：
Sub a()
'yngqq@2024年9月9日10:32:40
Dim mysel As AcadSelectionSet
Set mysel = ThisDrawing.SelectionSets.Add("mysel2")
Dim ftype(0) As Integer, fdata(0) As Variantftype(0) = 0: fdata(0) = "*line"
mysel.SelectOnScreen ftype, fdata
Stop
End Sub
Sub Example_SelectByPolygon()' This example adds objects to a selection set by defining a polygon.Dim ssetObj As AcadSelectionSetOn Error Resume NextThisDrawing.SelectionSets.Item("TEST_SSET3").DeleteOn Error GoTo 0Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_SSET3")' Add to the selection set all the objects that lie within a fenceDim mode As IntegerDim pointsArray(0 To 11) As DoubleDim pointsArray1(0 To 7) As DoubleFor Each ent In ThisDrawing.ModelSpaceent.color = acWhiteNext entThisDrawing.Regen acActiveViewportmode = acSelectionSetFencepointsArray(0) = 28.2: pointsArray(1) = 17.2: pointsArray(2) = 0pointsArray(3) = -5: pointsArray(4) = 13: pointsArray(5) = 0pointsArray(6) = -3.3: pointsArray(7) = -3.6: pointsArray(8) = 0pointsArray(9) = 28: pointsArray(10) = -3: pointsArray(11) = 0''pointsArray1(0) = 28.2: pointsArray1(1) = 17.2:pointsArray1(2) = -5: pointsArray1(3) = 13pointsArray1(4) = -3.3: pointsArray1(5) = -3.6pointsArray1(6) = 28: pointsArray1(7) = -3Dim mypl As AcadLWPolylineSet mypl = ThisDrawing.ModelSpace.AddLightWeightPolyline(pointsArray1)mypl.Closed = TrueZoomAll'ssetObj.SelectByPolygon mode, pointsArray' Add to the selection set all the Circles that lie within fenceReDim gpCode(0 To 1) As IntegergpCode(0) = 0gpCode(1) = 8Dim pnt(0 To 2) As Doublepnt(0) = 3: pnt(1) = 6: pnt(2) = 0ReDim dataValue(0 To 1) As VariantdataValue(0) = "Circle"dataValue(1) = 0Dim groupCode As Variant, dataCode As VariantgroupCode = gpCodedataCode = dataValuessetObj.SelectOnScreen groupCode, dataCode'ssetObj.SelectByPolygon acSelectionSetFence, pointsArray, groupCode, dataCodeFor Each ent In ssetObjent.color = acRedent.UpdateNext entStop
End Sub指定两个坐标窗口内选择：
Sub Example_SelectByPolygon()' This example adds objects to a selection set by defining a polygon.Dim ssetObj As AcadSelectionSetOn Error Resume NextThisDrawing.SelectionSets.Item("TEST_SSET3").DeleteOn Error GoTo 0Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_SSET3")' Add to the selection set all the objects that lie within a fenceDim mode As IntegerDim pointsArray(0 To 11) As DoubleDim pointsArray1(0 To 2) As DoubleDim pointsArray2(0 To 2) As DoubleFor Each ent In ThisDrawing.ModelSpaceent.color = acWhiteNext entThisDrawing.Regen acActiveViewportmode = acSelectionSetFencepointsArray(0) = 0: pointsArray(1) = 17.2: pointsArray(2) = 0pointsArray(3) = -5: pointsArray(4) = 13: pointsArray(5) = 0pointsArray(6) = -3.3: pointsArray(7) = -3.6: pointsArray(8) = 0pointsArray(9) = 28: pointsArray(10) = -3: pointsArray(11) = 0''pointsArray1(0) = 0: pointsArray1(1) = 0pointsArray1(2) = 0: pointsArray2(0) = 10000pointsArray2(1) = 10000: pointsArray2(2) = 0ZoomAll'ssetObj.SelectByPolygon mode, pointsArray' Add to the selection set all the Circles that lie within fenceReDim gpCode(0 To 1) As IntegergpCode(0) = 0gpCode(1) = 8Dim pnt(0 To 2) As Doublepnt(0) = 3: pnt(1) = 6: pnt(2) = 0ReDim dataValue(0 To 1) As VariantdataValue(0) = "Circle"dataValue(1) = 0Dim groupCode As Variant, dataCode As VariantgroupCode = gpCodedataCode = dataValuessetObj.Select acSelectionSetWindow, pointsArray2, pointsArray1'ssetObj.SelectByPolygon acSelectionSetFence, pointsArray, groupCode, dataCodeFor Each ent In ssetObjent.color = acRedent.UpdateNext entStop
End SubacSelectionSetCrossing为最大化框选（有交叉的都能选上），选中变红
acSelectionSetWindow为最小化框选（全部包围才算）, pointsArray2, pointsArray1
下图可知，红框左下角相交未完全包围的圆未变红，即未选中。
专注CAD二次开发、插件、代码，详情见下方 ↓
