|
|
马上注册，结识高手，享用更多资源，轻松玩转三维网社区。
您需要 登录 才可以下载或查看，没有帐号？注册
x
本帖最后由 woaishuijia 于 2012-11-13 06:04 编辑
- u# L0 O/ B, V' [7 T& L) K# B% ^% p) b3 G
从论坛得到一代码，可实现从AUTOCAD中提取文字至EXCEL，但提取的文字输出到EXCEL后生成的文字顺序与图纸的顺序会有时不同，哪位高手帮看下哪改，可让它按顺序提取+ e1 c0 t! C7 }0 u% K
具体代码如下 p$ F# @$ @1 k4 S' ~ o" o- \
Sub TQ()
: l) R! n- ?% x3 }4 x4 I On Error Resume Next3 i3 H5 T6 p# M7 m, q9 Q' Q8 H
Dim I As Integer
$ x0 M7 ]1 X% E( Q5 h2 p- o Dim E As Excel.Application, B As Workbook, S As Worksheet
, y: b& N, G o' I Dim SS As AcadSelectionSet, T As Object, FT(3) As Integer, FD(3) As Variant
9 b7 H( \+ w9 V4 J8 |: n '下面定义选择集过滤器列表为多行文字或单行文字& e( E D: H9 h" _7 L1 `6 g" d
FT(0) = -4: FD(0) = "<or"9 o. s5 S2 l6 l0 c1 s+ u; _" L
FT(1) = 0: FD(1) = "mtext"' a& `1 V% J/ |0 I( O- O8 `3 Q, Y
FT(2) = 0: FD(2) = "text", w8 L3 A* D* ]! i. I
FT(3) = -4: FD(3) = "or>"
y. f! E% l8 ?4 D$ u# K, G '创建选择集: x! B' U9 l! d# ]! A8 w
Set SS = ThisDrawing.SelectionSets.Add("SS")+ \4 H. U" L3 ^& t. s+ R" {
'在屏幕上选择多行文字或单行文字对象 v5 [5 f6 |3 N5 I; d
SS.SelectOnScreen FT, FD
6 N/ r, E. A2 g+ \1 L '如果选择集不为空则运行以下代码4 B1 l: U4 I/ J" S; V- a
If SS.Count > 0 Then N. I+ Q9 \. _- k/ B4 F4 ~* E) Y2 N
'运行EXCEL程序9 S- K4 ?+ C3 x
Set E = New Excel.Application
4 ^% Z( ~+ T. [; ] '在EXCEL中插入工作薄; @& L* C/ B, U9 a/ x7 `
Set B = E.Workbooks.Add
8 C1 T/ D8 G. _: E/ N& V '定义工作表4 n; o9 a# W a8 j
Set S = B.ActiveSheet
3 W3 K& s) Q& r& b2 {+ h. ?8 Z '显示EXCEL程序 Q! |- x5 o+ d! |
E.Visible = True
, K$ [* g6 z; |$ x$ o* ]; E9 g1 ~ '遍历选择集并处理被选中的单行文字或多行文字对象, l9 b$ s) t3 f3 a
For Each T In SS% |* C0 m8 x; @: \* e
I = I + 1! T+ m- `7 j8 P* U
'把单行文字或多行文字的内容写入表格
* ^ o3 \) |/ ` '对于多行文字，如果直接写入则字符串中很可能包含转义符，使用者可根据需要对字符串运算处理后再写入表格7 E+ A/ r% |5 D$ T: v: @) ~/ r u
S.Cells(I, 1).Value = T.TextString
$ _% i+ g* P& O, r3 G, ` Next
. I. F$ f7 b0 O' S& g End If8 R& Z( i+ w6 j# f
SS.Delete '删除用过的选择集
1 D Z3 q' D# M0 j I k X% i7 `End Sub |
|
发表于 2010-3-12 14:27:53
发表于 2010-3-12 16:16:32
,你总得给一个规则出来吧? 
楼主
发表于 2010-3-17 18:22:13