[例程]对象线色
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
页:
[1]