|
|
马上注册，结识高手，享用更多资源，轻松玩转三维网社区。
您需要 登录 才可以下载或查看，没有帐号？注册
x
使用方法：“Alt+F11”打开“VBA编辑器”，单击“工具”菜单，单击“引用”，在弹出的“引用－ACADObject”对话框中寻找并选中Microsoft Excel类型库(比如本机安装的Excel是2000版，引用的类型库就是“Microsoft Excel 9.0 Object Library”)。“确定”后退出对话框。双击“工程资源管理器”中的“ThisDrawing”对象，在弹出的代码窗口粘贴下面代码，“F5”运行。
! i7 ] r( F' F7 C$ q- S( H+ e! p; _ C* w, _0 d
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''3 I- n* ~( D6 N5 D0 y
Sub TC()
. Q# l) E1 g+ | Dim R As Integer, C As Integer, I As Integer, Ly As AcadLayer- D7 t7 G" N" F/ [' Q
Dim xlApp As Excel.Application, xlBook As Excel.Workbook
9 N# p" f9 W$ s. h( [8 h; _ 3 M" _; i( X( c" K
R = 1: C = 1 '从工作表的第1行第1列开始填写，使用者自行更改
' c: _, Q& s: B9 g. j9 U4 H
i! P: S' T& |* W Set xlApp = CreateObject("Excel.Application") '打开EXCEL程序
2 o/ h* e: f# t/ r& w xlApp.Visible = True '使EXCEL程序可见
4 [7 q- n# w$ x Set xlBook = xlApp.Workbooks.Add '插入新工作薄& X2 ?0 ^; o8 X) X" A
With xlBook.ActiveSheet
% @$ N* m" ? d/ b$ T, { .Name = "图层信息" '重命名当前工作表
+ t/ ^" a3 w$ a: U I = R
\4 F' w, A+ {) F5 m .Range(.Cells(I, C), .Cells(I, C + 11)).HorizontalAlignment = xlCenter '所有填写项目名称的单元格水平中心对齐" Q' v; F/ b- h$ k2 Y# B$ y/ A# z0 o
.Cells(I, C).Value = "序号" '以下代码逐列填写项目名称
s" I( ?( d/ Z: B/ C' D7 B .Cells(I, C + 1).Value = "状态". K; T% c" o: D; Y
.Cells(I, C + 2).Value = "名称"
5 S7 e( J- {- S Z, m .Cells(I, C + 3).Value = "开关"1 q0 U( Y8 i0 z' {: u d, N
.Cells(I, C + 4).Value = "冻结") ~1 I& d) s2 z8 ^. c+ I+ Z+ g1 J
.Cells(I, C + 5).Value = "锁定"
/ f: d+ ~+ J8 @* H3 L( P. l .Cells(I, C + 6).Value = "颜色"2 E8 V- l3 Z4 r) k$ ]' m
.Cells(I, C + 7).Value = "线型"
% ~. L7 `; C* \7 B/ D .Cells(I, C + 8).Value = "线宽"
$ n- V; e3 I" p, K- T" j .Cells(I, C + 9).Value = "打印样式"! {) p% j& l: p. f0 c& Q" d
.Cells(I, C + 10).Value = "打印"
4 w& V4 ^3 V9 G" z J* f .Cells(I, C + 11).Value = "说明"
$ d) M7 s. {7 C For Each Ly In ThisDrawing.Layers '遍历图层
: _% }! y- B) K- b I = I + 1 '在下一行填写该图层信息8 H# z- F9 g ~5 I8 c
.Range(.Cells(I, C), .Cells(I, C + 10)).HorizontalAlignment = xlCenter '前11项信息所在单元格水平中心对齐 z# E$ K' X0 x
.Cells(I, C + 11).HorizontalAlignment = xlLeft '填写图层说明的单元格水平左对齐
1 K8 _& i3 g/ x4 q: _/ r; F9 [ .Cells(I, C).Value = I - 1 '在第1列填写序号
+ b" a6 z i: }2 t. z If Ly.Used Then .Cells(I, C + 1).Value = "已使用" Else .Cells(I, C + 1).Value = "未使用" '第2列填写使用状态) I0 Y/ s, q, p
.Cells(I, C + 2).Value = Ly.Name '第3列填写图层名称
: d& W, y) K8 C5 \9 ^0 h If Ly.LayerOn Then .Cells(I, C + 3).Value = "开" Else .Cells(I, C + 3).Value = "关" '第4列填写开关状态' Y1 T& }. s" Y% r ^' Y6 L) f, e9 n7 V
If Ly.Freeze Then .Cells(I, C + 4).Value = "已冻结" Else .Cells(I, C + 4).Value = "未冻结" '第5列填写冻结状态( b! |5 g0 s7 N1 c ?
If Ly.Lock Then .Cells(I, C + 5).Value = "已锁定" Else .Cells(I, C + 5).Value = "未锁定" '第6列填写锁定状态. d; |) X1 _/ x+ G! c
Select Case Ly.TrueColor.ColorMethod '检查颜色定义的方法0 c1 J3 q& v: t
Case 194 '该图层颜色定义为RGB颜色时，在第7列填写RGB颜色* v. K4 |9 `2 J* d7 o) T. F
.Cells(I, C + 6).Value = "RGB颜色" & Ly.TrueColor.Red & "," & Ly.TrueColor.Green & "," & Ly.TrueColor.Blue0 Y T" R/ T. W; Y
Case 195 '该图层颜色定义为索引颜色时
( b% y- N$ R8 u! f" x Select Case Ly.TrueColor.ColorIndex+ [0 F+ h! ]) H& n: T7 {+ y
Case 1 '以下代码按索引号在第7列填写颜色名称
7 ^- U; ^" ?: _. U .Cells(I, C + 6).Value = "红"
$ W: L) z' i+ R5 V Case 2$ a u, b- d1 t) L9 Z
.Cells(I, C + 6).Value = "黄"0 l6 k! P& G6 B8 O) n6 ~8 ?
Case 30 G1 w$ C4 i! J
.Cells(I, C + 6).Value = "绿"
9 I2 N. M+ T% i8 W Case 4. `8 y$ i( E% q$ k% e
.Cells(I, C + 6).Value = "青"* L) G+ x, g. R& }0 r9 Y) [, L
Case 50 j/ W$ K$ H. m; Q
.Cells(I, C + 6).Value = "蓝"1 Y! |0 l& f7 F8 V3 Y
Case 6, c/ t5 y$ q# I- A8 K% P
.Cells(I, C + 6).Value = "洋红"2 l8 q) e) S6 w$ m/ H$ I
Case 7 H g0 ?3 d5 u# }
.Cells(I, C + 6).Value = "白"
$ Q; J3 s8 s# U) k& a Case Else '无名称的索引颜色在第7列填写索引号
( B' S4 M7 W# s, [; T, \3 v .Cells(I, C + 6).Value = "索引颜色" & Ly.TrueColor.ColorIndex/ V, y# U e& N' C4 A
End Select0 U# h0 ^1 T. p- ~0 Z
End Select
4 H7 }/ E7 t2 R, f4 G .Cells(I, C + 7).Value = Ly.Linetype '第8列填写线型名称
. g# f9 U/ o& x# k" V6 c' J Select Case Ly.Lineweight '第9列填写线宽
! w/ F1 J8 p0 x9 U$ |7 V Case -3 '; k4 m% l* T) j- k
.Cells(I, C + 8).Value = "默认"
. Y0 b" I# u2 ~ Case Else7 Z* n, B/ v1 G! v( ?
.Cells(I, C + 8).Value = Val(Ly.Lineweight) / 100
1 J* ]0 ^& D N3 V5 V End Select
8 {6 K# `: x2 L" k6 c .Cells(I, C + 9).Value = Ly.PlotStyleName '第10列填写打印样式名称! W0 e8 V3 `3 s: I
If Ly.Plottable Then .Cells(I, C + 10).Value = "打印" Else .Cells(I, C + 10).Value = "不打印" '第11列填写是否打印
% V p% d! p$ a9 j .Cells(I, C + 11).Value = Ly.Description '第12列填写图层说明) y- L/ U( b* P# v9 V
Next
% [+ b6 T% G; g3 X. M .Range(.Cells(R, C), .Cells(I, C + 11)).Columns.AutoFit '最适合的列宽
% T0 D) f- Q8 K4 t& Q2 x End With
# ^) W" M/ B/ R" XEnd Sub
. W. {- Z8 Q4 b, `'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''3 c7 q1 E* w x0 P% |, Q2 j
! d/ m. Q6 I$ m% B) r3 L# j
运行结果
9 _, @' M; e/ b# f" q
|
评分
-
查看全部评分
|
发表于 2008-6-17 11:38:22
发表于 2009-2-26 14:47:11