|
|
马上注册，结识高手，享用更多资源，轻松玩转三维网社区。
您需要 登录 才可以下载或查看，没有帐号？注册
x
使用方法：“Alt+F11”打开“VBA编辑器”，单击“工具”菜单，单击“引用”，在弹出的“引用－ACADObject”对话框中寻找并选中Microsoft Excel类型库(比如本机安装的Excel是2000版，引用的类型库就是“Microsoft Excel 9.0 Object Library”)。“确定”后退出对话框。双击“工程资源管理器”中的“ThisDrawing”对象，在弹出的代码窗口粘贴下面代码，“F5”运行。: l5 O: M8 q3 ^/ v! r8 ]
0 ?: y. q7 V8 d* j3 k9 Y/ F
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''', q( P6 w' Q! a* T. ]! H
Sub TC()4 B3 P/ I' P# T1 g- O6 u) V
Dim R As Integer, C As Integer, I As Integer, Ly As AcadLayer
7 ]2 M7 G) E: a) U3 h Dim xlApp As Excel.Application, xlBook As Excel.Workbook# W; @( ?( \+ S& V8 T/ E5 K' t
( m+ U) P- T7 m
R = 1: C = 1 '从工作表的第1行第1列开始填写，使用者自行更改9 q5 m! F3 x, v$ j8 u7 r& S
; k, o0 ^! m) i( I
Set xlApp = CreateObject("Excel.Application") '打开EXCEL程序
: [6 h: U" D( R& ` xlApp.Visible = True '使EXCEL程序可见
; }/ j) D2 v1 S# C Set xlBook = xlApp.Workbooks.Add '插入新工作薄, t/ q( o) A- A7 ~$ p$ T
With xlBook.ActiveSheet; w6 G& K2 ]/ l, O Z
.Name = "图层信息" '重命名当前工作表
7 H/ I5 L9 m+ G I = R k, b0 w1 A! h" Q' k& z" ^% `0 |
.Range(.Cells(I, C), .Cells(I, C + 11)).HorizontalAlignment = xlCenter '所有填写项目名称的单元格水平中心对齐7 g8 D n6 Q; ?/ }
.Cells(I, C).Value = "序号" '以下代码逐列填写项目名称
$ h! k+ b* ~9 a. [, k& ] .Cells(I, C + 1).Value = "状态"5 w8 O' S- ?2 ]' I
.Cells(I, C + 2).Value = "名称"
+ J: x2 D$ L9 p9 x' x .Cells(I, C + 3).Value = "开关"- o( F; C8 U8 U$ h
.Cells(I, C + 4).Value = "冻结"9 F: |* ^5 i( ]2 Y1 u
.Cells(I, C + 5).Value = "锁定"5 Q! [( l; S* B
.Cells(I, C + 6).Value = "颜色"
. M3 t7 W- l0 l6 r .Cells(I, C + 7).Value = "线型"* D; P3 x- k( ]0 ]# f
.Cells(I, C + 8).Value = "线宽"! m0 F4 u) x( j0 I- D5 C& v! |/ W
.Cells(I, C + 9).Value = "打印样式"
% g' _$ F( y0 R; D0 m. ] .Cells(I, C + 10).Value = "打印"
9 Y O% `0 u+ X .Cells(I, C + 11).Value = "说明"% C1 h; |) _1 Y% v0 E
For Each Ly In ThisDrawing.Layers '遍历图层$ T4 P1 ~7 K& \
I = I + 1 '在下一行填写该图层信息' J/ r# I# i, U1 x, i
.Range(.Cells(I, C), .Cells(I, C + 10)).HorizontalAlignment = xlCenter '前11项信息所在单元格水平中心对齐
: J, q8 R; E3 O8 |( R) C4 Q) j .Cells(I, C + 11).HorizontalAlignment = xlLeft '填写图层说明的单元格水平左对齐
4 u+ o2 N! x" P: C .Cells(I, C).Value = I - 1 '在第1列填写序号
: U( R7 t3 o7 J: H! l6 X If Ly.Used Then .Cells(I, C + 1).Value = "已使用" Else .Cells(I, C + 1).Value = "未使用" '第2列填写使用状态' P. v/ Y0 V% }9 J/ ~$ ~& r6 W$ B
.Cells(I, C + 2).Value = Ly.Name '第3列填写图层名称9 a! m/ q1 |1 R3 l1 F
If Ly.LayerOn Then .Cells(I, C + 3).Value = "开" Else .Cells(I, C + 3).Value = "关" '第4列填写开关状态
4 j: t9 K( l; h3 W- X* b If Ly.Freeze Then .Cells(I, C + 4).Value = "已冻结" Else .Cells(I, C + 4).Value = "未冻结" '第5列填写冻结状态! D3 k% j/ i" _7 f$ U- }+ D
If Ly.Lock Then .Cells(I, C + 5).Value = "已锁定" Else .Cells(I, C + 5).Value = "未锁定" '第6列填写锁定状态
2 Z1 A5 I/ f* t, K, H9 D Select Case Ly.TrueColor.ColorMethod '检查颜色定义的方法* }' v/ q' a6 O+ d! D
Case 194 '该图层颜色定义为RGB颜色时，在第7列填写RGB颜色; V. k4 V" V0 G* [9 F! b+ D
.Cells(I, C + 6).Value = "RGB颜色" & Ly.TrueColor.Red & "," & Ly.TrueColor.Green & "," & Ly.TrueColor.Blue, a- e& X0 S0 \) W5 j" e% r
Case 195 '该图层颜色定义为索引颜色时
% ]7 a3 G% ~, s' j. i+ Q) o0 o6 q Select Case Ly.TrueColor.ColorIndex v( `1 @/ N* e# B% P
Case 1 '以下代码按索引号在第7列填写颜色名称
- j" c8 o2 [6 a4 U" z3 K* B .Cells(I, C + 6).Value = "红". L$ ^; M! x: U: A
Case 2
4 {6 u2 J; ~5 G2 i% j& q' h .Cells(I, C + 6).Value = "黄" h; Z( ?: }% [! h: ~1 P! H' y
Case 3 h! G- b) Y' Q' |* d. ^! l
.Cells(I, C + 6).Value = "绿": m6 I+ Z2 x; s5 L' r( [2 a
Case 4
) ~$ P0 J6 s$ b( _- @, j .Cells(I, C + 6).Value = "青"# ^( y: W! p; `8 x
Case 5
! `% W% |& ~9 V' j" `" m8 o .Cells(I, C + 6).Value = "蓝" J& n( K: s/ e+ D
Case 6
3 p0 V$ F# @5 a, i6 O9 T .Cells(I, C + 6).Value = "洋红") O2 A) \" U% P2 D
Case 77 E! J' A3 R* S2 c; ]
.Cells(I, C + 6).Value = "白"% Y1 H1 y/ h' Y0 v
Case Else '无名称的索引颜色在第7列填写索引号
6 l/ U0 r9 G6 P6 k7 @0 Y4 c; H; k: A .Cells(I, C + 6).Value = "索引颜色" & Ly.TrueColor.ColorIndex. x$ D' s% k4 ^/ d6 ^$ y. z
End Select0 H' h0 `: i8 b+ q* y$ A6 y l
End Select3 G$ N, `5 D" A
.Cells(I, C + 7).Value = Ly.Linetype '第8列填写线型名称
, Z& r+ H! d" c K+ M8 j+ m" B Select Case Ly.Lineweight '第9列填写线宽0 p- ^0 i. k+ D2 i8 Z) E
Case -3 ') R. ^3 ~4 X' A3 @ }
.Cells(I, C + 8).Value = "默认"
1 A' @2 \0 d7 B* Y& v, U6 R, G0 q Case Else
+ P9 a; W6 P" } ^0 j .Cells(I, C + 8).Value = Val(Ly.Lineweight) / 100
3 O; b3 q' Q! A# _1 z! D End Select& X# X: L3 ^4 i, {9 e$ h! r. H
.Cells(I, C + 9).Value = Ly.PlotStyleName '第10列填写打印样式名称
% Z. c3 S0 l; l! a If Ly.Plottable Then .Cells(I, C + 10).Value = "打印" Else .Cells(I, C + 10).Value = "不打印" '第11列填写是否打印
{5 J% Q# W" \8 i5 w) s .Cells(I, C + 11).Value = Ly.Description '第12列填写图层说明- r, l, r( Z& J S0 t8 Q% B
Next
! o; e z( q- H& v( k- l7 s; N. f7 S .Range(.Cells(R, C), .Cells(I, C + 11)).Columns.AutoFit '最适合的列宽
3 a* A( O' N# A. v# n/ {( w" A End With
& J' E* `8 r" U: R% D' |* NEnd Sub
% d5 d! L& z7 B5 K'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+ M- |. f7 o0 {! d7 T3 f/ F6 Q3 f- w# F' z* c
运行结果
! {3 a4 ~1 b. Z- _4 O: q
|
评分
-
查看全部评分
|
发表于 2008-6-17 11:38:22
发表于 2009-2-26 14:47:11