|
|
马上注册，结识高手，享用更多资源，轻松玩转三维网社区。
您需要 登录 才可以下载或查看，没有帐号？注册
x
使用方法：“Alt+F11”打开“VBA编辑器”，单击“工具”菜单，单击“引用”，在弹出的“引用－ACADObject”对话框中寻找并选中Microsoft Excel类型库(比如本机安装的Excel是2000版，引用的类型库就是“Microsoft Excel 9.0 Object Library”)。“确定”后退出对话框。双击“工程资源管理器”中的“ThisDrawing”对象，在弹出的代码窗口粘贴下面代码，“F5”运行。( n* e. B! B7 r' D
! @4 a; Y+ |! S8 Q''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
: Q1 E. t1 H8 `0 JSub TC()
3 l" w2 A! s! L( U$ Y Dim R As Integer, C As Integer, I As Integer, Ly As AcadLayer9 {- \ O) Q, e% J& T7 W3 q- j
Dim xlApp As Excel.Application, xlBook As Excel.Workbook
# d& T/ E1 b) U& X 4 R4 G9 W& w, W' X8 l
R = 1: C = 1 '从工作表的第1行第1列开始填写，使用者自行更改
* t* @5 U9 }$ R" o: q . o6 K) r* B' ^3 c! J; R
Set xlApp = CreateObject("Excel.Application") '打开EXCEL程序; Y0 U V. N! m" h8 r W( m
xlApp.Visible = True '使EXCEL程序可见, t; R. i( U2 }: ~% T% V" b# ?! N
Set xlBook = xlApp.Workbooks.Add '插入新工作薄% e( l, r* x' d# g* r
With xlBook.ActiveSheet" l) n& s8 G5 E, A3 S& k
.Name = "图层信息" '重命名当前工作表
( X* T) [* b# |0 c [+ w I = R: d: y3 K, Z# K& n) f9 Q
.Range(.Cells(I, C), .Cells(I, C + 11)).HorizontalAlignment = xlCenter '所有填写项目名称的单元格水平中心对齐. O# }9 U3 J, N! o: c' w% _
.Cells(I, C).Value = "序号" '以下代码逐列填写项目名称
s# e9 K; m6 E& K6 n .Cells(I, C + 1).Value = "状态"' {3 F+ H- d0 Z+ d; L
.Cells(I, C + 2).Value = "名称"
. f0 T3 D4 \1 i; {; q6 ^ .Cells(I, C + 3).Value = "开关"
7 a V# n! {9 K* t9 P6 ?( a9 a .Cells(I, C + 4).Value = "冻结"& O& f! k# O& o# m8 K
.Cells(I, C + 5).Value = "锁定"
# O2 c. {$ G( \1 p7 h8 a .Cells(I, C + 6).Value = "颜色"
( D5 ?9 h: l. ?. Z( p3 X, d .Cells(I, C + 7).Value = "线型"; I$ E1 @( J5 ]) V
.Cells(I, C + 8).Value = "线宽"/ _* y. C o( Q
.Cells(I, C + 9).Value = "打印样式"
' T4 D9 X0 z& B, G, ^ .Cells(I, C + 10).Value = "打印"
2 u& W, e* {$ Z+ b6 U a .Cells(I, C + 11).Value = "说明"' a/ @' u$ ?# f2 z$ d
For Each Ly In ThisDrawing.Layers '遍历图层
$ ]' {8 c8 Q I I = I + 1 '在下一行填写该图层信息
/ Y/ T* D7 a- U) X+ W .Range(.Cells(I, C), .Cells(I, C + 10)).HorizontalAlignment = xlCenter '前11项信息所在单元格水平中心对齐
2 i" s" c! n, o7 \5 a3 g0 @& u .Cells(I, C + 11).HorizontalAlignment = xlLeft '填写图层说明的单元格水平左对齐- }: }' ~& x/ |1 Z8 [
.Cells(I, C).Value = I - 1 '在第1列填写序号
5 Y& r' P/ t0 q D8 r If Ly.Used Then .Cells(I, C + 1).Value = "已使用" Else .Cells(I, C + 1).Value = "未使用" '第2列填写使用状态, I; z! [9 I" p8 ^
.Cells(I, C + 2).Value = Ly.Name '第3列填写图层名称
% E S, Y0 Y) V' n, s5 {0 O If Ly.LayerOn Then .Cells(I, C + 3).Value = "开" Else .Cells(I, C + 3).Value = "关" '第4列填写开关状态
) t: Z5 g* M5 g! Q0 F1 [, D, M4 J If Ly.Freeze Then .Cells(I, C + 4).Value = "已冻结" Else .Cells(I, C + 4).Value = "未冻结" '第5列填写冻结状态9 i3 R( v7 c) I. n
If Ly.Lock Then .Cells(I, C + 5).Value = "已锁定" Else .Cells(I, C + 5).Value = "未锁定" '第6列填写锁定状态
) M0 R6 E+ l. U1 B4 u4 V Select Case Ly.TrueColor.ColorMethod '检查颜色定义的方法
/ J9 q0 f$ D! \# O+ ^ Case 194 '该图层颜色定义为RGB颜色时，在第7列填写RGB颜色9 c/ i% L3 @3 ?; c* B- I
.Cells(I, C + 6).Value = "RGB颜色" & Ly.TrueColor.Red & "," & Ly.TrueColor.Green & "," & Ly.TrueColor.Blue! k" ?# g; B, j! t8 I
Case 195 '该图层颜色定义为索引颜色时4 n, ?3 G* A. M$ Z1 T
Select Case Ly.TrueColor.ColorIndex; G& R- i2 y4 w' z: E: k$ C
Case 1 '以下代码按索引号在第7列填写颜色名称
! ?4 [- X% k% X/ E% `2 r) ]# R .Cells(I, C + 6).Value = "红"
; s U& ^1 o' l* f: h0 G Case 2
- P/ W& r2 c: s# H .Cells(I, C + 6).Value = "黄"- Y8 P- d, c0 R( P$ ^
Case 3
8 y$ J* H; ]1 q; B5 L) ` .Cells(I, C + 6).Value = "绿"' ]0 n- T- x6 L6 A0 z) j& t
Case 4
' n g( T' ?& \, a, N. ^" t0 d. }9 B .Cells(I, C + 6).Value = "青"5 H: C! O( H/ ~1 f
Case 5
# z; S+ T# N7 ^% x8 Y, y .Cells(I, C + 6).Value = "蓝": J$ e9 T) ~- A7 s- q# _
Case 6
' q* [& y# [4 _9 p .Cells(I, C + 6).Value = "洋红"
9 p. L' j* t5 c% \ Case 7; @7 F/ R$ C4 Z, }/ z' o
.Cells(I, C + 6).Value = "白"/ C; Q7 O- b4 a0 l7 D
Case Else '无名称的索引颜色在第7列填写索引号- }* }& t/ p" ]: r
.Cells(I, C + 6).Value = "索引颜色" & Ly.TrueColor.ColorIndex" k8 I" z P$ R" ^& u& M
End Select
2 `( x5 Y$ Y0 G+ w+ { End Select
+ S5 t# v7 E( h$ K3 V .Cells(I, C + 7).Value = Ly.Linetype '第8列填写线型名称4 |5 ]7 b* }$ Y9 Y1 Y; q$ b
Select Case Ly.Lineweight '第9列填写线宽6 j% C* e' J6 w% w
Case -3 '0 Q6 \+ k, E% w
.Cells(I, C + 8).Value = "默认"
+ x- ^' {1 ]: r5 t& }) s* t* N B Case Else
2 O4 z: A2 |* k( ~+ E" [' l: g. \ .Cells(I, C + 8).Value = Val(Ly.Lineweight) / 100 t* ]+ w2 e& M1 X5 j! L- @) n
End Select
9 [( T& e3 I6 c! [, h4 w: z .Cells(I, C + 9).Value = Ly.PlotStyleName '第10列填写打印样式名称
/ i4 C2 F& ]. ] R/ z" F2 ` If Ly.Plottable Then .Cells(I, C + 10).Value = "打印" Else .Cells(I, C + 10).Value = "不打印" '第11列填写是否打印
1 g1 g5 Y+ A: G! F( Y .Cells(I, C + 11).Value = Ly.Description '第12列填写图层说明 F& s0 O! }5 _2 x# y
Next
6 k% E4 K+ i" c! r9 o$ s .Range(.Cells(R, C), .Cells(I, C + 11)).Columns.AutoFit '最适合的列宽/ s$ M- D/ l. v6 n' y4 Q
End With
. T) F8 B5 o( _; pEnd Sub
0 e' {. J! x/ ~0 Q* J a2 s8 e8 O4 r'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''6 \& b5 W( _0 ^1 D* M5 P
: B( _& J! F- w$ g$ m0 E$ k- ]- X
运行结果
% W. s. O" `7 v5 j; {' q
|
评分
-
查看全部评分
|
发表于 2008-6-17 11:38:22
发表于 2009-2-26 14:47:11