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二次开发、插件、代码,详情见下方 ↓