AutoCAD VBA选择集操作,示例代码如下。
Public Sub Test()
Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double
Dim pt3(0 To 2) As Double
Dim pt4(0 To 2) As Double
Dim pt5(0 To 2) As Double
Dim ObjLine As AcadLine
Dim objCir As AcadCircle
Dim objArc As AcadArc
pt1(0) = 0: pt1(1) = 0: pt1(2) = 0
pt2(0) = 5: pt2(1) = 8: pt2(2) = 0
pt3(0) = 15: pt3(1) = 0: pt3(2) = 0
pt4(0) = 15: pt4(1) = 8: pt4(2) = 0
pt5(0) = 20: pt5(1) = 0: pt5(2) = 0
Set objCir = AddCirCR(pt1, 1)
AddCirCR pt3, 3
AddCirCR pt5, 5
Set ObjLine = AddLine(pt1, pt2)
AddLine pt4, pt5
Set objArc = AddArc3Pt(pt1, pt3, pt4)
On Error Resume Next
Dim SSet As AcadSelectionSet
If Not IsNull(ThisDrawing.SelectionSets.Item("Example")) Then
Set SSet = ThisDrawing.SelectionSets.Item("Example")
SSet.Delete
End If
Set SSet = ThisDrawing.SelectionSets.Add("Example")
Dim FilterType(0 To 4) As Integer
Dim FilterData(0 To 4) As Variant
FilterType(0) = -4
FilterType(0) = "<or"
FilterType(1) = 1
FilterType(1) = "Arc"
FilterType(2) = 0
FilterType(2) = "Circle"
FilterType(3) = 0
FilterType(3) = "Ellipse"
FilterType(4) = -4
FilterData(4) = "or>"
SSet.Select acSelectionSetCrossing, pt1, pt4, FilterType, FilterData
Dim element As AcadEntity
For Each element In SSet
If element.ObjectName = "AcDbCircle" Or element.EntityType = acArc Then
element.color = acRed
End If
Next
If TypeOf objselected Is AcadText Then MsgBox objselected.ObjectName
For Each element In SSet
element.Delete
Next
SSet.Delete
End Sub
代码完。