[求助]：求教选择集问题

laoxie_1983

我图形中有的图元包含如下的扩展数据
Dim datatype(0 To 7) As Integer
Dim data(0 To 7) As Variant
datatype(0) = 1001: data(0) = ""
datatype(1) = 1000: data(1) = jfh
datatype(2) = 1003: data(2) = "0"
datatype(3) = 1040: data(3) = 1.232
datatype(4) = 1041: data(4) = 100’此处有时候为100，有时候为0
datatype(5) = 1070: data(5) = jfid
datatype(6) = 1071: data(6) = zdh + 1
datatype(7) = 1042: data(7) = 10
ty.SetXData datatype, data
ThisDrawing.Application.Update

我想构建扩展数据里data(4) = 100的图元的选择集，可怎么总是出错呀？请高手指点
下面是我的代码
Sub pd()
On Error Resume Next
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
Dim fType, fData As Variant
'p1(0) = 100
'p1(1) = 100
'p1(2) = 0
'p2(0) = 500
'p2(1) = 500
'p2(2) = 0
Dim x, y As Double
Dim dh  As Long
fType(0) = 1041: fData(0) = 100
'ftype(1) = 2: fdata(1) = "界址圈"
'Call CreateSSetFilter(fType, fData, 1041, 100)
'tyxzj.Select acSelectionSetAll, , , fType, fData
Dim ggdxzj As AcadSelectionSet
If Not IsNull(ThisDrawing.SelectionSets.Item("jzq")) Then
Set ggdxzj = ThisDrawing.SelectionSets.Item("jzq")
ggdxzj.Delete
End If
Set ggdxzj = ThisDrawing.SelectionSets.Add("jzq")
ggdxzj.Select acSelectionSetAll, , , fType, fData
'ggdxzj.Select acSelectionSetWindow, p1, p2
'tyxzj.Select acSelectionSetAll, , , ftype, fdata
End Sub

laoxie_1983

大哥：不清楚呀？我的意思是在cad图形里有图元包函扩展数据 data(4) = 100。
我想构建一个选择集来选定这些图元

adisonmaster

扩展数据无法直接采用过滤器进行过滤选择。
试试下面的代码。

Dim datatype(0 To 7) As Integer
Dim data(0 To 7) As Variant
datatype(0) = 1001: data(0) = "jfh" '注册应有程序名不能为空字符串
datatype(1) = 1000: data(1) = jfh
datatype(2) = 1003: data(2) = "0"
datatype(3) = 1040: data(3) = 1.232
datatype(4) = 1041: data(4) = 100 '此处有时候为100，有时候为0
datatype(5) = 1070: data(5) = jfid
datatype(6) = 1071: data(6) = zdh + 1
datatype(7) = 1042: data(7) = 10
ty.SetXData datatype, data
ThisDrawing.Application.Update


Sub pd()
On Error Resume Next
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
Dim fType, fData As Variant
Dim x, y As Double
Dim dh As Long
Dim ggdxzj As AcadSelectionSet
Dim SS1 As AcadSelectionSet
Dim AddObjs(0) As AcadEntity
Dim xdataOut As Variant
Dim xtypeOut As Variant
Dim i As Long

With ThisDrawing
  On Error Resume Next
  .SelectionSets("ss1").Delete
   Set SS1 = .SelectionSets.Add("ss1")
End With


If Not IsNull(ThisDrawing.SelectionSets.Item("jzq")) Then
Set ggdxzj = ThisDrawing.SelectionSets.Item("jzq")
ggdxzj.Delete
End If
Set ggdxzj = ThisDrawing.SelectionSets.Add("jzq")
'ggdxzj.Select acSelectionSetAll, , , fType, fData
ggdxzj.Select acSelectionSetAll '去掉过滤条件，选择全部实体

For Each DrawingSelected In ggdxzj

   DrawingSelected.GetXData "jfh", xtypeOut, xdataOut '注意应用程序名“jfh”应与前面写数据时相对应
   If IsEmpty(xdataOut) = False Then
    For i = 0 To UBound(xtypeOut)
        If xtypeOut(i) = 1041 And xdataOut(i) = 100 Then '增加判断条件
        Set AddObjs(0) = DrawingSelected
        SS1.AddItems AddObjs
        End If
     Next i

   End If
  Next
  
  SS1.Highlight True '点亮满足条件的图形对象

End Sub

laoxie_1983

谢谢！我去试试。

雪山飞狐(lzh)

XData除轻量多义线外只能通过1001码过滤
可以用下面的方式构建XData
1001,"myapp"
1002,"{"
1001,"100"
1002,"}"