|
|
马上注册，结识高手，享用更多资源，轻松玩转三维网社区。
您需要 登录 才可以下载或查看，没有帐号？注册
x
使用方法：“Alt+F11”打开“VBA编辑器”，单击“工具”菜单，单击“引用”，在弹出的“引用－ACADObject”对话框中寻找并选中Microsoft Excel类型库(比如本机安装的Excel是2000版，引用的类型库就是“Microsoft Excel 9.0 Object Library”)。“确定”后退出对话框。双击“工程资源管理器”中的“ThisDrawing”对象，在弹出的代码窗口粘贴下面代码，“F5”运行。8 U! a8 P: S a. |
" i" \* g- X( ^; ^ U3 V8 W
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''& y( s5 m, V# |' p Q0 `
Sub TC()
$ I. t6 f" z* _- ] Dim R As Integer, C As Integer, I As Integer, Ly As AcadLayer# \9 B# X5 x) c+ S% b
Dim xlApp As Excel.Application, xlBook As Excel.Workbook+ {/ G2 C6 Y8 U" f# c& @
: R+ t+ |( k9 x- F5 W
R = 1: C = 1 '从工作表的第1行第1列开始填写，使用者自行更改, ]' \9 q H8 `1 g0 D9 V
: W' J7 q. S, z `+ `, e
Set xlApp = CreateObject("Excel.Application") '打开EXCEL程序+ s7 X& R% R- f1 Q) _- `2 ^
xlApp.Visible = True '使EXCEL程序可见- }: i2 S* f, b1 O
Set xlBook = xlApp.Workbooks.Add '插入新工作薄
$ S, _. n" H& [9 B) Z0 h With xlBook.ActiveSheet
8 e- t7 g4 J6 o n A* P% M/ i, z .Name = "图层信息" '重命名当前工作表
/ j- S/ J. u* b0 B U I = R& n! c& h2 _8 b+ d3 P
.Range(.Cells(I, C), .Cells(I, C + 11)).HorizontalAlignment = xlCenter '所有填写项目名称的单元格水平中心对齐
3 r/ o. y/ t" V+ s- L9 A .Cells(I, C).Value = "序号" '以下代码逐列填写项目名称) g; I- R% J, G* _! u, Y
.Cells(I, C + 1).Value = "状态"
( _8 n' `6 h& i4 j# y, D! Y1 g .Cells(I, C + 2).Value = "名称"
0 i4 ?# I# A5 G: j .Cells(I, C + 3).Value = "开关"
- U* y9 o; `2 r% ~6 I .Cells(I, C + 4).Value = "冻结"
3 [7 `) k* G8 Z0 G1 Q3 s .Cells(I, C + 5).Value = "锁定"/ z9 W4 _% A B. [6 ]
.Cells(I, C + 6).Value = "颜色"7 @" v' c4 R: ]) x' t5 o! O. B
.Cells(I, C + 7).Value = "线型"
1 o5 F w, b$ [2 ^ .Cells(I, C + 8).Value = "线宽"
6 |+ e3 g( Z' J+ c .Cells(I, C + 9).Value = "打印样式"
% C0 Z* o' {# s, { .Cells(I, C + 10).Value = "打印"
. x' ^& F. s1 A- t .Cells(I, C + 11).Value = "说明"' V: Q8 `% s) Y
For Each Ly In ThisDrawing.Layers '遍历图层
1 x4 L/ A8 Y9 n, [6 P1 `6 o I = I + 1 '在下一行填写该图层信息1 M& e- I) Z6 u# p3 Z- A' n4 K8 N
.Range(.Cells(I, C), .Cells(I, C + 10)).HorizontalAlignment = xlCenter '前11项信息所在单元格水平中心对齐. z9 G7 b" @* b% D+ D; i
.Cells(I, C + 11).HorizontalAlignment = xlLeft '填写图层说明的单元格水平左对齐6 E* |) l/ @+ m( _
.Cells(I, C).Value = I - 1 '在第1列填写序号$ z( s4 U1 L9 C
If Ly.Used Then .Cells(I, C + 1).Value = "已使用" Else .Cells(I, C + 1).Value = "未使用" '第2列填写使用状态# D$ ~3 }" w" ^8 [& `; p
.Cells(I, C + 2).Value = Ly.Name '第3列填写图层名称9 K4 q5 Z/ x) l5 n
If Ly.LayerOn Then .Cells(I, C + 3).Value = "开" Else .Cells(I, C + 3).Value = "关" '第4列填写开关状态
1 s C9 i, W: \+ Z If Ly.Freeze Then .Cells(I, C + 4).Value = "已冻结" Else .Cells(I, C + 4).Value = "未冻结" '第5列填写冻结状态% g. p: H5 l/ J) Y
If Ly.Lock Then .Cells(I, C + 5).Value = "已锁定" Else .Cells(I, C + 5).Value = "未锁定" '第6列填写锁定状态
' N3 D" Q' x- w& n: |4 b Select Case Ly.TrueColor.ColorMethod '检查颜色定义的方法0 c( b. `- B4 }7 L$ V/ Y- E
Case 194 '该图层颜色定义为RGB颜色时，在第7列填写RGB颜色" @" I7 m. k: S9 I' L
.Cells(I, C + 6).Value = "RGB颜色" & Ly.TrueColor.Red & "," & Ly.TrueColor.Green & "," & Ly.TrueColor.Blue% d2 R; W/ c1 t% ]
Case 195 '该图层颜色定义为索引颜色时
& o( d- \$ ^* f- ^$ s. o Select Case Ly.TrueColor.ColorIndex, e! t4 B5 _9 ]. L4 v
Case 1 '以下代码按索引号在第7列填写颜色名称
8 S3 f! e9 _# P7 l$ L! C .Cells(I, C + 6).Value = "红"+ T! j ^$ @3 X1 S
Case 2
$ @6 v# k8 P9 c4 K .Cells(I, C + 6).Value = "黄"
' K& e4 C! }* U Case 34 ], p0 s1 V/ o
.Cells(I, C + 6).Value = "绿"
, V7 T4 p4 o* V Case 46 T" s) a/ x: m/ c/ D/ K% Y
.Cells(I, C + 6).Value = "青". _ n' K5 y* s$ ~
Case 5
- E# `, k, P3 F .Cells(I, C + 6).Value = "蓝"
5 t D5 f& p' Z2 H) F Case 61 O3 m( H& [3 |. a6 N5 r
.Cells(I, C + 6).Value = "洋红"
1 j, m! ?2 t6 D Case 7
# C) |! s$ x/ H9 c! J9 o! R .Cells(I, C + 6).Value = "白"
. b6 Y6 }: P9 A9 c1 @9 ]# H V Case Else '无名称的索引颜色在第7列填写索引号
9 b( O" y; d$ u .Cells(I, C + 6).Value = "索引颜色" & Ly.TrueColor.ColorIndex2 ~7 H8 b9 D1 ?. z2 _& r
End Select
* o0 I4 L* V6 z- s7 r End Select
- K+ h' v g$ N) w4 _% r. }! | .Cells(I, C + 7).Value = Ly.Linetype '第8列填写线型名称! V9 D9 W; ^7 j
Select Case Ly.Lineweight '第9列填写线宽" V$ A- _9 l) B) E7 A" B/ B
Case -3 '# f* d, V. a1 Y5 F6 D, r: E' g
.Cells(I, C + 8).Value = "默认"
1 }7 r; B& A4 {, z/ p( K* p Case Else* h- `$ Z8 y. k' [0 N
.Cells(I, C + 8).Value = Val(Ly.Lineweight) / 100
+ b/ x9 m& V" V6 q3 |# T9 v' g3 e; h End Select
9 j5 F' G3 l) ~0 {% X$ F .Cells(I, C + 9).Value = Ly.PlotStyleName '第10列填写打印样式名称) _6 H& {1 i3 I7 q
If Ly.Plottable Then .Cells(I, C + 10).Value = "打印" Else .Cells(I, C + 10).Value = "不打印" '第11列填写是否打印
9 r: ~5 |* v9 x4 w .Cells(I, C + 11).Value = Ly.Description '第12列填写图层说明
6 g1 ]7 S5 [2 e( k Next) M V0 q4 S' K2 O# \, P. r
.Range(.Cells(R, C), .Cells(I, C + 11)).Columns.AutoFit '最适合的列宽
! M2 i0 A/ C4 o8 o, G' g, N End With
" x6 o; C" h* t$ m, |, zEnd Sub5 @) ~5 d, R! M2 |0 a
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''% n/ d- G, m, ^2 q( t- m
7 a% ?/ M2 y+ n8 a- }运行结果+ [1 b$ j8 V/ W6 g6 Q
|
评分
-
查看全部评分
|
发表于 2008-6-17 11:38:22
发表于 2009-2-26 14:47:11