|
|
马上注册,结识高手,享用更多资源,轻松玩转三维网社区。
您需要 登录 才可以下载或查看,没有帐号?注册
x
本帖最后由 woaishuijia 于 2012-11-13 06:04 编辑 + y) Q' w( F2 V- c5 M
6 @ t' I4 Z8 w; r/ n$ g* ^
从论坛得到一代码,可实现从AUTOCAD中提取文字至EXCEL,但提取的文字输出到EXCEL后生成的文字顺序与图纸的顺序会有时不同,哪位高手帮看下哪改,可让它按顺序提取
0 l, I7 z' { ?2 |& E具体代码如下% U5 N3 Q. W6 R
Sub TQ()
* z2 W: H- k( }, j% f) a$ V/ L9 m On Error Resume Next& \* q% f8 @8 ~' Y
Dim I As Integer9 [! Z, j W' T/ l
Dim E As Excel.Application, B As Workbook, S As Worksheet
& ~* h9 Q& F2 F6 o Dim SS As AcadSelectionSet, T As Object, FT(3) As Integer, FD(3) As Variant
- E% D, c$ `# P* _" v: S3 r '下面定义选择集过滤器列表为多行文字或单行文字; ]3 |! h8 H: X4 \4 O
FT(0) = -4: FD(0) = "<or"
9 c* W" C, k8 A# h4 \9 O! V FT(1) = 0: FD(1) = "mtext"9 q6 X4 d; j, h! A
FT(2) = 0: FD(2) = "text"9 y. ?) F* r+ G
FT(3) = -4: FD(3) = "or>"
7 D2 E! q6 Y- G; T '创建选择集; K( U0 R0 H; r, I: q+ I# \% A" K& W
Set SS = ThisDrawing.SelectionSets.Add("SS")
( _7 U2 Y1 e. | '在屏幕上选择多行文字或单行文字对象. p( g* z/ V* m' [9 x' h V
SS.SelectOnScreen FT, FD$ S/ B/ ^+ l: c# k. w) J1 q( H/ h
'如果选择集不为空则运行以下代码3 m! j* {' J/ _- D7 h/ X' v& e
If SS.Count > 0 Then
$ J6 J) J0 J u: v8 w3 L5 v '运行EXCEL程序
9 ~' C: h9 v5 U; d K$ n7 y1 F Set E = New Excel.Application0 g2 v& k+ H" w: ?; v) Y' {1 R
'在EXCEL中插入工作薄
8 P% d" J( c/ s4 x Set B = E.Workbooks.Add
( h/ u0 R8 \- Z$ a3 o$ r3 C$ q '定义工作表& M: W ?% l) B: c- U
Set S = B.ActiveSheet
/ q3 I2 r; j6 x6 L3 R '显示EXCEL程序/ a3 \0 `2 S" t# I
E.Visible = True
- Q3 M7 b+ K$ \: n+ U '遍历选择集并处理被选中的单行文字或多行文字对象( o9 L" z; g# M+ Z
For Each T In SS
! v4 a+ Q! t+ S6 A2 @ I = I + 1* J) B: w! M/ y# |
'把单行文字或多行文字的内容写入表格( i# P2 m3 d* G* g: J1 z: u
'对于多行文字,如果直接写入则字符串中很可能包含转义符,使用者可根据需要对字符串运算处理后再写入表格
- } Z4 g9 ~7 P6 K S.Cells(I, 1).Value = T.TextString- ]% F0 M6 g) R* |" @% G$ I# m
Next5 f! Z0 A5 D9 K* w2 f
End If
6 Q1 A3 W; m! i6 g6 ~! J$ f) a SS.Delete '删除用过的选择集
- |6 i7 ^1 c2 C, s) z# \End Sub |
|