|
|
马上注册，结识高手，享用更多资源，轻松玩转三维网社区。
您需要 登录 才可以下载或查看，没有帐号？注册
x
本帖最后由 woaishuijia 于 2012-11-13 06:04 编辑 $ w+ `0 d2 h* S. Z1 u0 L8 ]& w
9 x4 e- f. g& Z
从论坛得到一代码，可实现从AUTOCAD中提取文字至EXCEL，但提取的文字输出到EXCEL后生成的文字顺序与图纸的顺序会有时不同，哪位高手帮看下哪改，可让它按顺序提取
# w' o6 R5 B/ s: u5 f) c7 n具体代码如下
4 j" \. F" Q- z. j6 BSub TQ()2 h9 E. I& x: D9 a) H5 W
On Error Resume Next
/ G' h% r Z5 V0 O5 ?6 i5 o Dim I As Integer6 j% u: x( @# Q1 t# _0 I% Y2 }% k9 w
Dim E As Excel.Application, B As Workbook, S As Worksheet
$ U' P. f/ y6 n9 F: ] Dim SS As AcadSelectionSet, T As Object, FT(3) As Integer, FD(3) As Variant x6 f5 S: N1 Z& J j2 c) d
'下面定义选择集过滤器列表为多行文字或单行文字
& K7 L3 `8 W8 P! W$ S& [. R; m; v, Y FT(0) = -4: FD(0) = "<or"% g+ B2 A; R9 t# o# \2 u3 A' b
FT(1) = 0: FD(1) = "mtext"
6 P+ H. c: f5 u+ a1 D. ~ FT(2) = 0: FD(2) = "text"/ Z3 ]3 c, M! H; \9 X
FT(3) = -4: FD(3) = "or>"' Y3 ~2 [; G3 q
'创建选择集
! a* m5 E; |7 t; }; K9 c& |" t Set SS = ThisDrawing.SelectionSets.Add("SS")
' ^( ?3 o5 z7 k, d p8 p5 B '在屏幕上选择多行文字或单行文字对象
1 G0 Q/ p" D1 E! s) {! [; X$ w SS.SelectOnScreen FT, FD$ J5 ` v0 R" R3 @. h
'如果选择集不为空则运行以下代码- R5 ^' @) B# t Y& E' b) t
If SS.Count > 0 Then
+ C- k* g; s5 G* ~ '运行EXCEL程序
* ?) n, {9 x$ g' s* R9 K! l Set E = New Excel.Application5 ^1 T8 h. Y3 J% o1 T- z' w+ _% I$ j
'在EXCEL中插入工作薄
& U2 z2 @; z2 {& A Set B = E.Workbooks.Add# G! P6 N6 j. ~, v% Y4 [& y
'定义工作表# t% M: z, F9 B8 ] p
Set S = B.ActiveSheet) a8 z/ Q8 m5 f( d. v' p* I
'显示EXCEL程序' d* V: c- f ^& K' G* o
E.Visible = True4 R& D. `9 h2 A2 j+ O, S6 ], I
'遍历选择集并处理被选中的单行文字或多行文字对象
2 }6 N9 m6 k& U. B For Each T In SS+ s9 e8 u: S4 b9 W. t
I = I + 1
9 y/ L9 w* E7 j" c' l '把单行文字或多行文字的内容写入表格* \; B2 L l; p. X1 J
'对于多行文字，如果直接写入则字符串中很可能包含转义符，使用者可根据需要对字符串运算处理后再写入表格! A7 r" G3 O/ h' e! Q: ~
S.Cells(I, 1).Value = T.TextString
5 ^" \" o5 e4 ^- N; j7 t# G2 i Next, I/ u. J$ A5 O' r
End If
2 L' R( d1 a5 K: b" R SS.Delete '删除用过的选择集
$ r1 k8 E7 q, x7 H& t- `5 D% mEnd Sub |
|
发表于 2010-3-12 14:27:53
发表于 2010-3-12 16:16:32
,你总得给一个规则出来吧? 
楼主
发表于 2010-3-17 18:22:13