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

yuangw1234 发表于 2006-8-21 23:19:00

本帖最后由作者于 2006-8-22 12:18:49 编辑 本人是想做个颜色过滤的程式:先选一个参考物体,看其颜色是什么(假如acred),然后框选屏幕,理想是只能选择与参考物体颜色一样(acred)的物体,包括层物体颜色为bylayer,而对应层也是acred的
为了能选取颜色可能为bylayer而其实对应层的颜色也为acred的物体,我第二次框选了所有颜色为bylarer的物体,然后将那些颜色为bylayer而其对应的层的颜色不为acred物体过滤掉,如下用红色程式处(RemoveItems方法),为什么没有过滤掉呢,请大师指点 (我觉得错误可能在绿色程式处,因为刚开始redim Robj(0)的时候没有东西,即Robj(1)才开始有东西,可是好象必须redim Robj(0),要不提示了下标超界)
 Public 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 发表于 2006-8-22 08:49:00

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 发表于 2006-8-22 09:00:00

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

页: [1]

明经CAD社区's Archiver

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