以下程式无法颜色过滤

yuangw1234 发表于 2006-8-13 18:23:00

问题如下：
假如一条线的颜色是红色，另一条是绿色，颜色不用ByLayer,程式有过滤作用;可是当都是ByLayer刚失效，用此程式失效的结果是两条线都被选择，请问如何解决，本以为将obj.color改成obj.Truecolor，结果不对
Public Sub Ys() On Error Resume Next Dim Ssetobj As AcadSelectionSet, Str As Integer, Obj As AcadEntity, Pt As Variant ThisDrawing.Utility.GetEntity Obj, Pt: Obj.Highlight True Str = Obj.color ThisDrawing.SelectionSets("ys").Delete Err.Clear Set Ssetobj = ThisDrawing.SelectionSets.Add("ys") Dim Ftype(1) As Integer, Fdata(1) As Variant Ftype(0) = 0 Fdata(0) = "*" Ftype(1) = 62 Fdata(1) = Str Ssetobj.SelectOnScreen Ftype, Fdata End Sub

fjfhgdwfn 发表于 2006-8-13 18:48:00

如果bylayer 哪就再判断下层的颜色吧

yuangw1234 发表于 2006-8-14 08:12:00

請問一下，下層的顏色是什麼意思？能不能用VBA關鍵字提示一下

fjfhgdwfn 发表于 2006-8-14 08:34:00

判断下层的颜色
先得到object.layer,
再判断
layer.color

yuangw1234 发表于 2006-8-14 12:05:00

先謝謝，我去試試

yuangw1234 发表于 2006-8-14 13:34:00

試了一下，好象不行，大師可不可以在我的程式上修改一下，就如選擇的參考物體的顏色是綠色，那麼我就只要過濾綠色的物體，不管Bylayer是綠色，還是實際是綠色

雪山飞狐_lzh 发表于 2006-8-14 15:12:00

引用我的增强选择集类（在我的博客里找：）），运行下面的程序
Sub ttx()     Dim ss As New TlsSelectSet     ss.Init     ss.Filter.SetData -4, "<or", 62, acRed     For Each i In ThisDrawing.Layers         If i.Color = acRed Then             ss.Filter.AppendData -4, "<and", 8, i.Name, 62, acByLayer, -4, "and>"         End If     Next i     ss.Filter.AppendData -4, "or>"     ss.SelectObject acSelectionSetAll     MsgBox ss.Count End Sub 
或者
Sub ttx()     Dim ss As New TlsSelectSet     ss.Init     For Each i In ThisDrawing.Layers         If i.Color = acRed Then             s = s & i.Name & ","         End If     Next i     s = Left(s, Len(s) - 1)     ss.Filter.SetData -4, "<or", 62, acRed, -4, "<and", 8, s, 62, acByLayer, -4, "and>", -4, "or>"     ss.SelectObject acSelectionSetAll     MsgBox ss.Count End Sub

yuangw1234 发表于 2006-8-15 08:37:00

请问一下版主，你的那个New TlsSelectSet 是自定义的变量，它是acadselectionset还是什么呢？能不能把那个自定义的变量也发上来，因为我用你的程式，发现也找不到 Init这个属性

雪山飞狐_lzh 发表于 2006-8-15 08:55:00

不是让你在我的博客上找了么：）
还是贴过来吧：）
下面的代码放在TlsSelectSet类模块中
<A href="http://xsfhlzh.139.com/article/325507.html" target="_blank" >http://xsfhlzh.139.com/article/325507.html</A>
下面的模块放在TlsResultBuffer类模块中
<A href="http://xsfhlzh.139.com/article/332841.html" target="_blank" >http://xsfhlzh.139.com/article/332841.html</A>

yuangw1234 发表于 2006-8-15 11:37:00

先謝謝版主

页: [1]

明经CAD社区's Archiver

以下程式无法颜色过滤