仿qselect 命令---选择集+过滤器

兰州人

仿qselect 命令

练习选择集+过滤器用法。

Sub ReadEntityData()
  Dim Obj As AcadEntity
  Dim sel As AcadSelectionSet
  Dim seldata(0) As Variant, selcode(0) As Integer
  Dim gpdata As Variant, gpcode As Variant
  Dim pt(0 To 2) As Double, pt1(0 To 2) As Double

    With ThisDrawing
        ret = .Utility.GetPoint(, "指定左上角：")
        SetRet ret, pt
        ret = .Utility.GetCorner(pt, "指定对角点：")
        SetRet ret, pt1
        Set sel = .SelectionSets.Add("ss")
        selcode(0) = 0: gpcode = selcode
        seldata(0) = "Line": gpdata = seldata
        sel.Select acSelectionSetCrossing, pt, pt1, gpcode, gpdata
        Debug.Print sel.count
        .SelectionSets.Item("ss").Clear
        'Set sel = .SelectionSets.Add("ss")
        selcode(0) = 0: gpcode = selcode
        seldata(0) = "Dimension": gpdata = seldata
        sel.Select acSelectionSetCrossing, pt, pt1, gpcode, gpdata
        Debug.Print sel.count        
        .SelectionSets.Item("ss").Delete
    End With
   
End Sub

Private Sub SetRet(ret As Variant, pt() As Double)
    pt(0) = ret(0)
    pt(1) = ret(1)
    pt(2) = ret(2)
End Sub