|
|
发表于 2008-7-19 00:01:06
|
显示全部楼层
来自： 中国
回复 10# 的帖子
可以用二次开发功能编程提取。以下是VBA例程：
% j" U! i0 h1 ]$ X" M' \+ h; i8 T# C: K4 a7 ^/ j
-----------------------------------------------------------
) j1 a$ o8 K- I; d( z7 [Sub TQ()
+ c0 k' ~* j1 i On Error Resume Next
6 P" J" u7 }5 S5 ?$ L% w) J/ a6 Q Dim I As Integer
' H( M- ^" R, T% @+ U7 d Dim E As Excel.Application, B As Workbook, S As Worksheet) o- `7 c' i; Z7 g
Dim SS As AcadSelectionSet, T As Object, FT(3) As Integer, FD(3) As Variant
+ y' T: x7 j. q1 Y$ j- C '下面定义选择集过滤器列表为多行文字或单行文字0 s8 N; @. I! s o& s" h
FT(0) = -4: FD(0) = "<or"
* a2 b. O$ ~& m4 h4 \ FT(1) = 0: FD(1) = "mtext": P6 Q; H2 J& \$ I& J
FT(2) = 0: FD(2) = "text"
3 y; L+ J' U( ~7 H2 A3 o( Y- b! [ FT(3) = -4: FD(3) = "or>"
l; M- z; j0 ?& i6 V9 G '创建选择集
% p& d4 |3 G3 ^- m Set SS = ThisDrawing.SelectionSets.Add("SS")- ^) V3 m7 E2 `
'在屏幕上选择多行文字或单行文字对象
. W( o8 m8 Q) h) x! ]+ m! t' X! }9 c SS.SelectOnScreen FT, FD! m6 D+ k: _4 V, P
'如果选择集不为空则运行以下代码
' Y3 Y/ o2 S3 R If SS.Count > 0 Then
* N1 _* W I- v '运行EXCEL程序7 z% n% h# w( C" k
Set E = New Excel.Application
7 y4 d0 [/ v) L7 L. g% x* z7 v% e '在EXCEL中插入工作薄
U. p0 Q- r2 x2 U1 }. g Set B = E.Workbooks.Add
/ ?% `5 h* S4 i3 r' L '定义工作表" q0 |! I* s3 }" c* p+ h
Set S = B.ActiveSheet2 B w/ @4 P* f/ c& o8 t
'显示EXCEL程序# J$ i! C# b1 }0 B6 ^- A
E.Visible = True
+ p! \+ O0 \; }- _7 M; ~- u '遍历选择集并处理被选中的单行文字或多行文字对象8 e( X0 u. G7 d( P3 B9 U6 O
For Each T In SS" j/ r7 H0 [0 y
I = I + 1* y2 P) K3 P" [5 D
'把单行文字或多行文字的内容写入表格! s; L1 h8 w7 y! W8 A
'对于多行文字，如果直接写入则字符串中很可能包含转义符，使用者可根据需要对字符串运算处理后再写入表格
6 T( i! C6 m' ]' U: |$ l S.Cells(I, 1).Value = T.TextString
8 o C+ q: ~& v; `; i+ a Next
?4 A" }; s5 q2 u End If, _; [8 a4 y- D% H
SS.Delete '删除用过的选择集2 `2 g9 s' r2 Z' ?
End Sub
3 w+ S/ ^; W( i8 |+ @; ^) X-----------------------------------------------------------------+ R# E4 a/ f4 }, k, L
! L% h4 n, P P; U6 B. e/ g7 v
“Alt+F11”打开VBA编辑器，将以上代码复制粘贴到thisdrawing对象代码窗口，在“工具”菜单下点“引用”，选择EXCEL类库（名称与EXCEL版本有关，如EXCEL2000为“Microsoft Excel 9.0 Object Library”），确定后即可使用。
) Z: H9 j4 k- n
3 a7 D3 |3 h" l+ L7 Q[ 本帖最后由 woaishuijia 于 2008-7-19 02:39 编辑 ] |
评分
-
查看全部评分
|
[复制链接]
发表于 2008-7-18 11:52:53
楼主
发表于 2008-7-18 13:50:41