窗选特定对象——选择集——CAD-vba

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 Variant
 ftype(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 AcadSelectionSet
    On Error Resume Next
    ThisDrawing.SelectionSets.Item("TEST_SSET3").Delete
    On Error GoTo 0
    Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_SSET3")
     
    ' Add to the selection set all the objects that lie within a fence
    Dim mode As Integer
    Dim pointsArray(0 To 11) As Double
    Dim pointsArray1(0 To 7) As Double
    For Each ent In ThisDrawing.ModelSpace
        ent.color = acWhite
    Next ent
    ThisDrawing.Regen acActiveViewport

    mode = acSelectionSetFence
    pointsArray(0) = 28.2: pointsArray(1) = 17.2: pointsArray(2) = 0
    pointsArray(3) = -5: pointsArray(4) = 13: pointsArray(5) = 0
    pointsArray(6) = -3.3: pointsArray(7) = -3.6: pointsArray(8) = 0
    pointsArray(9) = 28: pointsArray(10) = -3: pointsArray(11) = 0
    ''
    pointsArray1(0) = 28.2: pointsArray1(1) = 17.2:
    pointsArray1(2) = -5: pointsArray1(3) = 13
    pointsArray1(4) = -3.3: pointsArray1(5) = -3.6
    pointsArray1(6) = 28: pointsArray1(7) = -3
    Dim mypl As AcadLWPolyline
    Set mypl = ThisDrawing.ModelSpace.AddLightWeightPolyline(pointsArray1)
    mypl.Closed = True
    ZoomAll
    'ssetObj.SelectByPolygon mode, pointsArray
    
    ' Add to the selection set all the Circles that lie within fence
    ReDim gpCode(0 To 1) As Integer
    gpCode(0) = 0
    gpCode(1) = 8
    
    Dim pnt(0 To 2) As Double
    pnt(0) = 3: pnt(1) = 6: pnt(2) = 0
    
    ReDim dataValue(0 To 1) As Variant
    dataValue(0) = "Circle"
    dataValue(1) = 0
    
    Dim groupCode As Variant, dataCode As Variant
    groupCode = gpCode
    dataCode = dataValue
    ssetObj.SelectOnScreen groupCode, dataCode
    'ssetObj.SelectByPolygon acSelectionSetFence, pointsArray, groupCode, dataCode
    For Each ent In ssetObj
    ent.color = acRed
    ent.Update
    Next ent
    
    Stop
End Sub

指定两个坐标窗口内选择：

Sub Example_SelectByPolygon()
    ' This example adds objects to a selection set by defining a polygon.
    
    Dim ssetObj As AcadSelectionSet
    On Error Resume Next
    ThisDrawing.SelectionSets.Item("TEST_SSET3").Delete
    On Error GoTo 0
    Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_SSET3")
     
    ' Add to the selection set all the objects that lie within a fence
    Dim mode As Integer
    Dim pointsArray(0 To 11) As Double
    Dim pointsArray1(0 To 2) As Double
    Dim pointsArray2(0 To 2) As Double
    For Each ent In ThisDrawing.ModelSpace
        ent.color = acWhite
    Next ent
    ThisDrawing.Regen acActiveViewport

    mode = acSelectionSetFence
    pointsArray(0) = 0: pointsArray(1) = 17.2: pointsArray(2) = 0
    pointsArray(3) = -5: pointsArray(4) = 13: pointsArray(5) = 0
    pointsArray(6) = -3.3: pointsArray(7) = -3.6: pointsArray(8) = 0
    pointsArray(9) = 28: pointsArray(10) = -3: pointsArray(11) = 0
    ''
    pointsArray1(0) = 0: pointsArray1(1) = 0
    pointsArray1(2) = 0: pointsArray2(0) = 10000
    pointsArray2(1) = 10000: pointsArray2(2) = 0

    ZoomAll
    'ssetObj.SelectByPolygon mode, pointsArray

    ' Add to the selection set all the Circles that lie within fence
    ReDim gpCode(0 To 1) As Integer
    gpCode(0) = 0
    gpCode(1) = 8
    
    Dim pnt(0 To 2) As Double
    pnt(0) = 3: pnt(1) = 6: pnt(2) = 0
    
    ReDim dataValue(0 To 1) As Variant
    dataValue(0) = "Circle"
    dataValue(1) = 0
    
    Dim groupCode As Variant, dataCode As Variant
    groupCode = gpCode
    dataCode = dataValue
    ssetObj.Select acSelectionSetWindow, pointsArray2, pointsArray1
    'ssetObj.SelectByPolygon acSelectionSetFence, pointsArray, groupCode, dataCode
    For Each ent In ssetObj
    ent.color = acRed
    ent.Update
    Next ent
    
    Stop
End Sub

 acSelectionSetCrossing为最大化框选（有交叉的都能选上），选中变红

 acSelectionSetWindow为最小化框选（全部包围才算）, pointsArray2, pointsArray1

下图可知，红框左下角相交未完全包围的圆未变红，即未选中。

专注CAD二次开发、插件、代码，详情见下方 ↓