[例程]对象线色

mccad

Public Sub UseColor()

    Dim newLayer As AcadLayer
    '获得0层
    Set newLayer = ThisDrawing.Layers("0")
    '将0层设为青色
    newLayer.Color = acCyan
'--------------------------------------------------
    Dim blkObj As AcadBlock
    Dim blkinsPnt(0 To 2) As Double
    blkinsPnt(0) = 0: blkinsPnt(1) = 0: blkinsPnt(2) = 0
    '创建一个名为bk1的图块
    Set blkObj = ThisDrawing.Blocks.Add(blkinsPnt, "bk1")
'--------------------------------------------------
    Dim cirObj As AcadCircle
    Dim cen(0 To 2) As Double
    Dim radius As Double
    '创建第1个圆
    cen(0) = 0: cen(1) = 0: cen(2) = 0
    radius = 80
    Set cirObj = blkObj.AddCircle(cen, radius)
    '该圆的颜色设为随层
    cirObj.Color = acByLayer
   
    '创建第2个圆
    cen(0) = 0: cen(1) = 0: cen(2) = 0
    radius = 60
    Set cirObj = blkObj.AddCircle(cen, radius)
    '第2个圆的颜色设为随块
    cirObj.Color = acByBlock
   
    '创建第3个圆，对颜色属性不设置
    cen(0) = 0: cen(1) = 0: cen(2) = 0
    radius = 40
    Set cirObj = blkObj.AddCircle(cen, radius)
   
    '创建第4个圆
    cen(0) = 0: cen(1) = 0: cen(2) = 0
    radius = 20
    Set cirObj = blkObj.AddCircle(cen, radius)
    '该圆的颜色设为红色
    cirObj.Color = acRed
'-------------------------------------------------
    '准备将4个圆组成的图块插入模型空间
    Dim blkRefObj As AcadBlockReference
    Dim insPnt(0 To 2) As Double
    insPnt(0) = 200: insPnt(1) = 150: insPnt(2) = 0
    '将3个圆组成的块插入模型空间
    Set blkRefObj = ThisDrawing.ModelSpace.InsertBlock _
                    (insPnt, "bk1", 1#, 1#, 1#, 0#)
'-------------------------------------------------
    Dim lineObj As AcadLine
    Dim sPnt(0 To 2) As Double, ePnt(0 To 2) As Double
    '在模型空间单独创建第1条直线段
    sPnt(0) = 200: sPnt(1) = 150: sPnt(2) = 0
    ePnt(0) = 300: ePnt(1) = 186: ePnt(2) = 0
    Set lineObj = ThisDrawing.ModelSpace.AddLine(sPnt, ePnt)
   
    '在模型空间单独创建第2条直线段
    sPnt(0) = 200: sPnt(1) = 150: sPnt(2) = 0
    ePnt(0) = 100: ePnt(1) = 186: ePnt(2) = 0
    Set lineObj = ThisDrawing.ModelSpace.AddLine(sPnt, ePnt)
    '将第2条直线段的颜色设为绿色
    lineObj.Color = acGreen
   
    ThisDrawing.Regen acActiveViewport
   
    MsgBox "准备将层换色！"
    newLayer.Color = acYellow

    ThisDrawing.Regen acActiveViewport

End Sub

Public Sub lx1()

    Dim blkObj As AcadBlock
    Dim blkinsPnt(0 To 2) As Double
    blkinsPnt(0) = 0: blkinsPnt(1) = 0: blkinsPnt(2) = 0
    '创建一个名为bk1的图块
    Set blkObj = ThisDrawing.Blocks.Add(blkinsPnt, "bk1")

    Dim cirObj As AcadCircle
    Dim cen(0 To 2) As Double
    Dim radius As Double
    '创建第1个圆
    cen(0) = 0: cen(1) = 0: cen(2) = 0
    radius = 80
    Set cirObj = blkObj.AddCircle(cen, radius)

    Dim blkRefObj As AcadBlockReference
    Dim insPnt(0 To 2) As Double
    insPnt(0) = 200: insPnt(1) = 150: insPnt(2) = 0
    '将3个圆组成的块插入模型空间
    Set blkRefObj = ThisDrawing.ModelSpace.InsertBlock(insPnt, "bk1", 1#, 1#, 1#, 0#)
    blkRefObj.Color = acYellow
   
    ThisDrawing.Regen acActiveViewport
'----------------------------------------
    Dim blkObj1 As AcadBlock
    '创建一个名为bk1的图块
    Set blkObj1 = ThisDrawing.Blocks.Add(blkinsPnt, "bk2")
   
    Dim lineObj As AcadLine
    Dim sPnt(0 To 2) As Double, ePnt(0 To 2) As Double
    '在模型空间单独创建第1条直线段
    sPnt(0) = 0: sPnt(1) = 0: sPnt(2) = 0
    ePnt(0) = 100: ePnt(1) = 36: ePnt(2) = 0
    Set lineObj = blkObj1.AddLine(sPnt, ePnt)
   
    '在模型空间单独创建第1条直线段
    sPnt(0) = 0: sPnt(1) = 0: sPnt(2) = 0
    ePnt(0) = -100: ePnt(1) = 36: ePnt(2) = 0
    Set lineObj = blkObj1.AddLine(sPnt, ePnt)
   
    Dim blkRefObj1 As AcadBlockReference
    '将3个圆组成的块插入模型空间
    Set blkRefObj1 = ThisDrawing.ModelSpace.InsertBlock(insPnt, "bk2", 1#, 1#, 1#, 0#)
    blkRefObj1.Color = acByBlock
   
    ThisDrawing.Regen acActiveViewport

End Sub