|
|
发表于 2009-2-9 12:27:54
|
显示全部楼层
来自: 中国辽宁营口
在VBA中设置和修改对象颜色有新旧两种方法。& J: B0 T( f' Z1 N
在2004以前的老版本,图形、组和图层对象有一个Color属性,其值为0到256,分别代表ByBlock(0)、ByLayer(256)和255种索引颜色,每种颜色对应的索引值可以在CAD图形界面的颜色对话框中看到。
2 q9 F6 [1 W/ S" q改变对象颜色只需要修改对象的Color属性为目标颜色的索引值就可以了。7 i6 ~# q: w: }0 r5 u# v& b/ T1 x
在2004以后版本,由于CAD的颜色增加了真彩色,而Color属性只能使用索引颜色,因而被Autodesk宣布废除了,在新版本的对象浏览器中也看不到Color属性了(但事实上在新版本中仍然可以使用)。代替Color属性的是TrueColor属性。对TrueColor属性赋值需要引用AcCmColor对象,AcCmColor对象的属性主要包括ColorIndex(相当于老版本的Color属性,使用索引颜色)、Red、Green、Blue(红、绿、蓝三种颜色分量,每个属性值分别为0到255)和EntityColor(长整形数,代表32位颜色)。
: z# x- x4 H6 G4 c. I1 }6 B: h改变颜色时,首先要声明一个AcCmColor对象,把其颜色改为目标颜色,然后再把其赋值给图形、组和图层对象的TrueColor属性。
: u2 e6 i4 E6 U) ?1 f) o" @下面的代码是使用Color属性的例子
0 a4 R* F J* }: i- - \4 `, p' x( i8 B) h K' q) f2 ?, j
- Sub A()- W7 |9 o+ C9 S, h/ ~& N2 |, Z
- '声明一个二维填充对象和所用的点 K4 ]& K |) L7 \
- Dim S As AcadSolid, P1(2) As Double, P2(2) As Double, P3(2) As Double1 Y6 q4 I1 N3 ~9 C( S5 S2 R$ S7 F
- '定义二维填充顶点, D5 J. J0 Z. p$ @7 W* r$ x
- P2(0) = 100 k0 I5 a# F5 A- ]
- P3(0) = 10: P3(1) = 10( ]) ^% }5 e. ~: q* ^% O# l. A
- '创建二维填充
) M0 g5 i" U) z" y6 f3 ~& i4 ` - Set S = ThisDrawing.ModelSpace.AddSolid(P1, P2, P3, P3)
' U8 K9 J* ]: H7 @- a( M - '二维填充的颜色改为红色。其中acRed是CAD七种标准颜色之一“红色”的命名常量,相当于1 l) A" W' u3 k9 E' ^/ a7 k: |- E
- S.color = acRed7 l5 U6 G2 l7 w: U) y
- End Sub
" y- n% P1 i: w- b& ^: O
复制代码 n$ s a9 ]" W3 l; d! Y, b
下面的代码是使用TrueColor属性的例子! N; H5 E3 ]2 S7 j
. F" ~4 @9 D" P$ c- Sub A()# P9 g8 M( E2 s2 V- x3 ~
- '声明一个二维填充对象和所用的点
6 `: V) n4 A4 V% z& S- ?# d( | m% N - Dim S As AcadSolid, P1(2) As Double, P2(2) As Double, P3(2) As Double' S8 ]. G" d$ L5 i \" t- G
- '声明并新建一个颜色) S: v' U- B+ y0 R& T
- Dim C As New AcadAcCmColor k7 G: g7 y6 Z. T2 W
- '定义二维填充顶点. S! v/ X' y! J
- P2(0) = 10
1 {4 l, v# i+ v - P3(0) = 10: P3(1) = 10* {7 @4 Z- ^& F k5 K1 a
- '创建二维填充7 r" a* o% j/ Z8 u
- Set S = ThisDrawing.ModelSpace.AddSolid(P1, P2, P3, P3)
a5 r2 B/ e% X( F8 g* y - '颜色C使用CAD索引颜色“红色”
) D* n' P3 i6 N) n3 W9 k - C.ColorIndex = acRed
8 e4 a" _7 G, \! I+ C: K+ t% R - '二维填充的颜色改为颜色C
6 y/ K1 N! d0 }$ N2 o - S.TrueColor = C
& }! v, |* `& A2 n5 t& K - End Sub
. M( y# Y" {1 d& `$ F5 y( ^
复制代码 |
|