[求助]：如何将所有对象颜色随层？

sollom

大部分图元颜色都不随层（有上万的图元），如何快速使颜色随层？

tsuihan

第一种方法：打开所有图层、全选所有对象，设置颜色为ByLayer；（缺点：无法改变块内部成员的颜色、标注的每一个细节颜色、属性的颜色）。

第二种方法：
'''
'''Create by TsuiHan@163.com
'''
Sub setAllByLyr()
    Dim setClr As ACAD_COLOR
    setClr = acByLayer      'target color value
   
    Dim elem As AcadEntity
    For Each elem In ThisDrawing.ModelSpace
        elem.Color = acBlue
        If elem.ObjectName = "AcDbBlockReference" Then
            setBlockColor elem.Name, setClr
            
            If elem.HasAttributes Then
                'need to change the color of attributes
                'not completed
            End If
        End If
    Next
End Sub

Private Function setBlockColor(blkName As String, colorValue As ACAD_COLOR)
    Dim thisBlk As AcadBlock
    Set thisBlk = ThisDrawing.Blocks.Item(blkName)
    Dim i As Integer
    For i = 0 To thisBlk.Count - 1
        thisBlk.Item(i).Color = colorValue
        If thisBlk.Item(i).ObjectName = "AcDbBlockReference" Then
            setBlockColor thisBlk.Item(i).Name, colorValue    'loop of block in block
        End If
    Next
End Function


''这个程序能改变块成员的颜色，但没能改变“属性”的颜色和标注的细节颜色，你可以继续完成。

sollom

感谢2楼楼主详细的解答。
存在一个问题是，对象太多，即使通过过滤器选择颜色不随层的对象，执行起来需要好长的时间。
CAD里颜色随层的命令是什么？能通过命令来实现吗？

tsuihan

图元这么多，无论怎么修改，一定需要时间的。

问题是：这个动作做一次不就好了吗？需要经常做吗？


*****
另外补充一下我在2楼说的方法，标注的颜色可以通过修改样式来完成。

sollom

谢谢斑竹，由于工作就是出用地红线，蓝线等，需要对除范围线层和坐标层之外的图层进行颜色的改变。我发现通过如下命令可以实现，速度快多了。
caddoc.SendCommand  "change" & vbCr & "all" & vbCr & vbCr & "p" & vbCr & "c" & vbCr & "bylayer" & vbCr & vbCr

qiaqiadeng

好，收藏，我最喜欢简单，说句不该说的，我可不敢苟同二楼兄弟的方法。

gdzhou

建议做一个工具条。加入宏命令
所有元素颜色随层〔change all  p c bylayer ;〕
清块〔-pu a * n;〕
打开所有层〔-la on * ;〕
关闭所有层，除了当前层〔-la off *  ;〕
很方便的