cad图快速转换成黑白的

Sub ColorToBlack()
    '打开所以锁定的图层
    On Error Resume Next
    '将所有层的颜色设置为白色
    Dim A As AcadLayer
    For Each A In ThisDrawing.Layers
        'A.Freeze = False
        A.Lock = False
        'MsgBox A.ObjectName
        A.color = acWhite
    Next
    '将所以对象颜色设置随层(所有的层颜色都已经为白色)
    Dim E As AcadEntity

    For Each E In ThisDrawing.ModelSpace
        'MsgBox E.ObjectName
        E.color = acByLayer
        'E.color = acWhite
    Next

    '将所有的块的子对象颜色设置为随层(所有的层颜色都已经为白色)
    Dim B  As AcadBlock
    Dim i As Long

    For Each B In ThisDrawing.Blocks
        'MsgBox B.ObjectName
        'MsgBox B.Count
        For i = 0 To B.Count - 1
            'MsgBox B.item(i).ObjectName
            B.item(i).color = acByLayer
        Next i
    Next
End Sub

[本日志由田草于 2007-05-12 08:25 PM 编辑]

分享到： QQ空间新浪微博腾讯微博微信更多

暂时没有评论

发表评论 - 不要忘了输入验证码哦！

作者：

用户：密码：注册？验证：