RemoveItems方法为什么不对(請飛狐版主幫忙)

yuangw1234

本人是想做个颜色过滤的程式:先选一个参考物体,看其颜色是什么(假如acred),然后框选屏幕,理想是只能选择与参考物体颜色一样(acred)的物体,包括层物体颜色为bylayer,而对应层也是acred的

为了能选取颜色可能为bylayer而其实对应层的颜色也为acred的物体,我第二次框选了所有颜色为bylarer的物体,然后将那些颜色为bylayer而其对应的层的颜色不为acred物体过滤掉,如下用红色程式处(RemoveItems方法),为什么没有过滤掉呢,请大师指点 (我觉得错误可能在绿色程式处,因为刚开始redim Robj(0)的时候没有东西,即Robj(1)才开始有东西,可是好象必须redim Robj(0),要不提示了下标超界)

 ublic Sub Ys()
On Error Resume Next
Dim Ssetobj As AcadSelectionSet, Str As Integer, Obj As AcadEntity, Pt As Variant
Dim La As String, Robj() As AcadObject, I As Integer, Lb As String, Co As Integer, Ro As AcadObject
ThisDrawing.Utility.GetEntity Obj, Pt: Obj.Highlight True
Str = Obj.color
If Str = 256 Then
    La = Obj.Layer
    Str = ThisDrawing.Layers(La).color
End If
ThisDrawing.SelectionSets("ys").Delete
Err.Clear
Set Ssetobj = ThisDrawing.SelectionSets.Add("ys")
Dim Ftype(3) As Integer, Fdata(3) As Variant
ReDim Robj(0) As AcadObject
Ftype(0) = -4: Fdata(0) = "<OR"
Ftype(1) = 62: Fdata(1) = Str
Ftype(2) = 62: Fdata(2) = acByLayer
Ftype(3) = -4: Fdata(3) = "OR>"
Ssetobj.SelectOnScreen Ftype, Fdata
For I = 0 To Ssetobj.Count - 1
    Set Ro = Ssetobj.Item(I)
    Lb = Ro.Layer
    Co = ThisDrawing.Layers(Lb).color
    Select Case Co
        Case Is <> Str
        ReDim Preserve Robj(UBound(Robj) + 1)
        Set Robj(UBound(Robj)) = Ro
    End Select
Next I
Robj(0).Delete
Ssetobj.RemoveItems (Robj)
End Sub

wyj7485

For I = 0 To Ssetobj.Count - 1
    Set Ro = Ssetobj.Item(I)
    Lb = Ro.Layer
    Co = ThisDrawing.Layers(Lb).color
    Select Case Co
        Case Is <> Str
        ReDim Preserve Robj(UBound(Robj) + 1)
        Set Robj(UBound(Robj)) = Ro
    End Select
Next I
Robj(0).Delete
Ssetobj.RemoveItems (Robj)
'这段有何用?

前面的已经能实现你的要求了啊

yuangw1234

前面程式有缺陷，你要是画一些顏色为bylayer的它都可以选的(虽然和参考物体的顏色不一样)