社区 › VB › 真彩色滤光器

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...
也以失败告终。
有什么办法吗？或任何想法？
**** Hidden Message *****

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

255,194,10=20对我来说

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

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

Bryco 发表于 2008-4-21 23:59:46

Bryco，用chobo显示的颜色创建4个圆圈，然后在每个圆圈上使用（entget（car（entsel））。DXF 62代码显示除指定30之外的所有代码为40，因此过滤SS（在dxf 62=40上）获得4个中的3个。他们只想要一个特别是ACI颜色40的。

Jeff_M 发表于 2008-4-22 01:06:55

抱歉，我解释得不好..
我的目标是仅选择ACI颜色实体
1。选择实体使用组码“62”(任何ACI颜色以及40)
2。从selectionset中减去真彩色实体，因为组码“62”不支持真彩色。
3。选择开始设置抓地力
非常感谢Jeff_M，Bryco！！

Bryco 发表于 2008-4-22 10:11:41

55194，10=20，我不能再这样了<我是说，我在想什么。

查看完整版本: 真彩色滤光器