真彩色滤光器

chobo · 发表于 2008-4-21 02:04:10

我想选择几个相同的ACI颜色实体，然后显示抓地力。
在绘图...
一些实体颜色=255,194,10（True Color）
一些实体颜色=40（ACI颜色）
所有这些实体都是相同的ACI颜色40（但我想过滤True Color实体）
我正在尝试遵循代码...因为它似乎是DXF组过滤器不支持True Color
Sub ColorFilter（）
Dim对象SelSet As AcadSelectionSet
On Error Resume Next
ThisDrawing.SelectionSets（"sset"）。删除
在错误转到错误这里
设置目标SelSet=ThisDrawing.SelectionSets.Add（"sset"）
Dim intGcode（0）As intger
Dim varCodeData（0）As Variant
intGcode（0）=62
varCodeData（0）="40"
objSelSet.SelectacSelectionSetAll，， intGcode， varCodeData
Dim lngMax As Long
Dim lngCnt As Long
Dim obRemove（0）As AcadEntity
lngMax=objSelSet.Count
For lngCnt=0 To lngMax-1
对象集删除（0）=objSelSet.Item（lngCnt）
如果对象删除（0）。TrueColor.ColorMethod=acColorodByRGB然后
objSelSet.RemoveItems对象删除
结束如果
下一步
"_P"&Chr（34) & ")) "
Exit Sub
错误这里：
如果错误那么
Err.Clear
MsgBoxErr.Description
结束如果
结束Sub
'----------------------------
但是，它不起作用
我试图http://discussion.autodesk.com/thread.jspa?messageID=415583使用VLAX而不是上面的SendCommand...
也以失败告终。
有什么办法吗？或任何想法？

本帖以下内容被隐藏保护；需要你回复后，才能看到！

游客，如果您要查看本帖隐藏内容请回复

Bryco · 发表于 2008-4-21 10:55:43

255,194,10=20对我来说

chobo · 发表于 2008-4-21 20:46:50

Chobo，
您的代码在迭代SelectionSet时从SelectionSet中删除对象......这是禁忌。此外，您在报告错误之前清除了错误处理程序中的错误，因此它在错误MsgBox中没有显示任何内容。
我认为以下代码符合您的期望。我不喜欢使用SendCommand，但如果不使用VL类，这是我现在唯一能想到的方法。

copy

Option Explicit
Sub ColorFilter()
    Dim objSelSet As AcadSelectionSet
    On Error Resume Next
    ThisDrawing.SelectionSets("sset").Delete
    On Error GoTo ErrHere
   
    Set objSelSet = ThisDrawing.SelectionSets.Add("sset")
    Dim intGcode(0) As Integer
    Dim varCodeData(0) As Variant
    intGcode(0) = 62
    varCodeData(0) = "40"
    objSelSet.Select acSelectionSetAll, , , intGcode, varCodeData
   
    Dim lngMax As Long
    Dim lngCnt As Long
    Dim objRemove() As AcadEntity
    Dim objEnt As AcadEntity
    Dim I As Integer
    
    lngMax = objSelSet.Count
    For lngCnt = 0 To lngMax - 1
        Set objEnt = objSelSet.Item(lngCnt)
        If objEnt.TrueColor.ColorMethod = acColorMethodByRGB Then
            ReDim Preserve objRemove(I)
            Set objRemove(I) = objEnt
            I = 1 + I
        End If
    Next
    objSelSet.RemoveItems objRemove
    If objSelSet.Count > 0 Then
        ThisDrawing.SendCommand "(setq ss (ssadd)) "
        For Each objEnt In objSelSet
            ThisDrawing.SendCommand "(ssadd (handent " & Chr(34) & objEnt.Handle & _
                                     Chr(34) & ") ss) "
        Next
    End If
    ThisDrawing.SendCommand "(sssetfirst nil ss) "
    objSelSet.Delete
    Exit Sub
   
ErrHere:
    If Err Then
        MsgBox Err.Description
        Err.Clear
    End If
End Sub