CAD VBA 图元颜色跟随图层

原创已于 2024-11-10 21:01:37 修改 · 266 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#cad

于 2024-11-10 20:20:15 首次发布

CAD VBA 专栏收录该内容

77 篇文章

订阅专栏

效果如下：

一、所有图元颜色为bylayer

Sub 图元颜色跟随图层()
Dim item As AcadEntity

For Each item In ThisDrawing.ModelSpace
item.color = acByLayer
Next
ThisDrawing.Regen acActiveViewport
End Sub

二、与图层颜色相同（不是bylayer）:

Sub 图元颜色跟随图层()
Dim item As AcadEntity
Dim itemlayer As AcadLayer
    For Each item In ThisDrawing.ModelSpace
        layername = item.Layer
        Set itemlayer = ThisDrawing.Layers(layername)
        item.color = itemlayer.color 
    Next
    ThisDrawing.Regen acActiveViewport
End Sub