excel如何得到线的长度?

sblisb · 发表于 2011-10-18 19:11:10

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

您需要登录才可以下载或查看，没有帐号？注册

x

我想在excel中操作,得到打开的cad文件中择的线的长度,然后写入excel表.
其中选择效果就象在cad中选菜单下的"工具_查询_列表显示",选择后按空格或回车,得到线的长度就分别写入excel表中A列了.
在网上搜索了两天,得到如下代码,偶vba不好,请哪位高手帮我整合下,谢谢!
excel中操作cad请参考下面的步骤：

在EXCEL VBA编辑器的“工具”菜单中点“引用”，在“引用”对话框中找到ACAD类库，勾选它，确定。见图
3 S; J1 a# U9 c4、在EXCEL VBA编辑器Sheet1对象代码窗口写如下代码
0 `4 w$ Q* `# W3 J9 \+ u3 \" {Sub A()
6 e$ Q: H- `4 \+ S- ]' \4 ^+ B8 l+ P/ V; i% G# k* u% l
Dim CAD As AcadApplication '声明一个AutoCAD应用程序对象
; T' J) b2 r# L9 X! @. c% e% ^- MDim DOC As AcadDocument '声明AutoCAD文档对象
6 U" f) r# E) f/ w5 r" ySet CAD = New AcadApplication '运行一个新的AutoCAD进程8 o! N ^/ {( r& T% }2 ^; ~
CAD.Visible = True '使运行的AutoCAD程序可见。如果没有这行，程序将不可见，就是说看不见CAD窗口，只能在Windows任务管理器看到有CAD程序运行5 ?: C; N8 Z# I( \8 p: I3 o2 l
Set DOC = CAD.Documents.Open(Sheet1.Cells(1, 1).Value) '按照“Sheet1”工作表第一行第一列单元格的内容打开文件
+ v7 j& q5 y5 A/ }; `$ k3 LDOC.SendCommand Sheet1.Cells(1, 2).Value '按“Sheet1”工作表第一行第二列单元格的内容向CAD命令行发送命令, r P5 ]" B: X7 [$ y
sub

;;;=================================================================*, I) n3 e0 G& Z% d* g
;;;功能：测量线的长度 *; N% o9 O# T) Z  S5 @
;;;日期：zml84 于 2009-05-21 17:45 *
/ A/ y* g4 _5 {; B9 ?(defun C:cd ()9 x2 r) H- g* \/ ?/ H! ^
(princ "统计线段长度"9 s2 b7 q, E! i) c6 s% @
(if (setq SS (ssget '((0 . "LINE,ARC,CIRCLE,ELLIPSE,*POLYLINE,SPLINE"))
( G' C( C& _( k)8 ~- O) \1 {7 l3 w. [: C
)
  K  |( m0 P, g6 Y& a$ S+ H3 R(progn1 e& P7 K! X  |2 c  n6 i" J+ L
;;
3 ~9 z( ?" f/ m  |$ }7 ^. `(setq LST_LEN '()+ x" c) \0 |4 U
I 0' w* X( @% E% \" n2 h& J
)" e4 d& t5 M) b
;;逐个统计
- u8 ?& {8 H4 x! [$ F! l/ a(repeat (sslength SS)# `8 u- Q" [0 x. b& {
(setq EN (ssname SS I)
8 i7 i5 @$ l& ^9 QLEN (vlax-curve-getdistatparam$ r8 x6 q7 M+ k( i) l
EN/ I" H2 h2 k' D, |. H# v7 t: Z
(vlax-curve-getendparam EN)
: L# j! @( M5 K5 y. D- g. `)1 _/ n0 H# G1 s. @
LST_LEN (cons LEN LST_LEN): p% r3 H7 h  Z- p) t$ `
I (1+ I)
8 ~+ z% U" D# E, h)
; D& n8 i  B' |3 `' g; D0 I) 1 S" |" e0 ~! m" \( b: j
(setq LST_LEN (reverse LST_LEN))  g2 `3 f/ a( s
;;显示输出
3 O$ Z" G4 c) k; d0 l(princ "\n找到个数：")4 U# E. l) C/ v
(princ (sslength SS))2 O- F8 A7 ^7 m* L3 \/ p5 K  P
(princ "\n单个长度：")
( `  r5 t& R7 y, d, V2 G8 {1 H(princ LST_LEN)
3 k  P. L! X/ y: R2 R9 S( K(princ "\n总计长度：")  m3 r; j% W! ?0 F8 k3 U
(princ (apply '+ LST_LEN))
' @1 P  a& ^: g" d8 o& E)$ b7 E$ b8 r5 k* n3 f1 s" R5 e
)
- J' q; |$ q9 O& o(princ)
" b8 }* ^. n% C0 b$ ?3 s' r)
) H1 T; v+ E4 X# U5 T% d;;;=================================================================*/ C$ ^8 a! E: n% L6 @
;;;(alert
/ W0 C  F4 `, ?- A7 i% V2 Y;;; "功能：统计线段长度\n命令：\"CD\"\n日期：zml84 于 2009-05-21 17:45"
+ [) r9 g/ M7 p9 r;;;)7 _9 u) J# c: D' ?% X* w8 ~' v: N- j
(princ)

’在AutoCAD中编程序，写到c盘根目录下的“123.xls”Excel表格中

’使用 VBA IDE 中的“工具” “引用”菜单选项，选择 Microsoft Excel 9.0 对象模型2 A# J! W. o7 R% ^4 z
’水平不高，有点罗嗦，楼主可以精简下
. D  y* b8 P4 G6 p+ R- q’欢迎以后交流，QQ 42123043
8 P2 G" Y; w8 J2 R" M" h( \Public Sub 取坐标()3 c) Y3 c6 P: |8 y
’把AutoCAD中某一图层“多段线层”中的所有多段线的坐标列出来$ j2 D" n  x- W% E' O2 b: t* Y) n- ]9 f
Dim PLSet As AcadSelectionSet% V$ q4 [: m) }
Dim pl As AcadLWPolyline* O4 ^- M0 G7 {- ?  L7 p1 J- j

- i0 J6 e% K# ^9 o* t; w4 Q
9 k3 M, ]- ?3 a( l+ rDim ExcelApp As Excel.Application
4 P- [  @" ?1 s( IDim ExcelSheet As Object
: @3 h0 `: y' q- w9 M. N) ZDim ExcelWorkbook As Object- W4 X" \2 ^; j# I2 {3 X

+ `9 k8 l( Q4 c
8 O+ _% \- \3 d) Q6 X8 hDim pts As Variant/ x2 J- ]$ }7 v

8 u4 o9 R: y: h/ p* D# L) qDim NN As Integer
; Y1 S# X# n6 ]0 E0 b7 EDim j As Integer
/ G4 I9 }, n7 p- c/ Z) K
. h: {+ U0 q6 ^$ y- E0 e7 oDim pn As Integer: ^- Q% i2 T1 i9 |  n
2 b# o9 N3 K: [, I% B: i
Dim px(0 To 10000) As Double/ L, w3 h& Q0 U0 x/ o
Dim py(0 To 10000) As Double3 V, z& `' f& l/ j$ ]3 }
Dim pz(0 To 10000) As Double$ y# j5 U7 x3 H& k7 F0 o8 B& j0 K. L

& x# D: i; I% }/ h+ F
$ V+ p4 T& w: j. g! V8 p; DDim filtertype(10) As Integer8 V8 g3 u1 G$ d  p5 y
Dim filterdata(1) As Variant$ a; o$ {# G7 D) `

2 U# B* E0 t1 l! R7 P4 i' O) Hfiltertype(0) = 0 ’ 选择线型. S4 M  P7 l! E* u: @9 Y3 Y# P
filterdata(0) = "LWPOLYLINE"
0 q% J) m& M, X" I3 S( Ofiltertype(1) = 8 ’ 图层标识，可以根据具体情况改动' n) t' A+ f9 R3 K* m: w
filterdata(1) = "多段线层"
: K- H, u9 d+ S5 [
- E. c* k) Y' h# W, E; P6 Z/ Q% d' X  b) Y) Z) ?  Z
, \4 B; y/ i! T4 ^. u
Set PLSet = ThisDrawing.SelectionSets.Add("pl")1 u" o3 r) a4 X5 B3 n! O
PLSet.SelectOnScreen filtertype, filterdata8 ?# C; {; N; A( b- W6 K
7 ], P  `$ f" r
NN = 0
9 _7 Y7 P* u1 G9 Oj = 09 h9 j. ^3 z8 D6 {
For Each pl In PLSet. t* f: G; u3 ?5 t+ V/ l

0 c. J$ C% Y; {# Vpts = pl.Coordinates9 X$ ^( O5 K& ~) V
pn = (UBound(pts) + 1) / 2
; M6 ^3 d, j$ k* j( X
( g9 r! q* Z$ g1 sFor i = 0 To pn - 14 |" d7 s  |  i
px(i + pn * j) = pts(2 * i)( F7 f5 J3 j8 C5 p7 ]3 A
py(i + pn * j) = pts(2 * i + 1)
3 |9 R1 X% m2 |) G1 k3 ZNext i# u3 E  @! c1 T0 q: k
j = j + 1
$ r$ v+ l* U7 L7 p4 ONN = NN + pn; }% i& P: i: h4 G+ }
Next pl, R5 y* C$ K  O& G

/ E2 w8 p: R8 f8 TPLSet.Delete8 p8 F6 C! ~5 d% z4 j+ Y% E( l. z% h' [

( O8 _; O% n6 v1 p5 W: A/ H6 z  K+ ]- l  _$ c5 T
Set ExcelApp = New Excel.Application
, f) U: @: z9 `" Q1 b7 P, x  n: ~, h) C4 T3 O' j0 D
Set ExcelWorkbook = ExcelApp.Workbooks.Add6 B5 D1 r" g! T

9 B- C3 W' W( d1 X) LSet ExcelSheet = ExcelApp.ActiveSheet5 v' c; n6 E8 b! v
3 L* B# a/ K' i. p
ExcelWorkbook.SaveAs "c:\123.xls"# T- L/ b" v3 V4 c- B6 a+ [, H. y# P

. S4 A3 f- [# @9 I9 qExcelSheet.Cells(1, 1) = "x"
8 K9 o( ^3 p# S& QExcelSheet.Cells(1, 2) = "y"5 a& v2 ]7 Z4 e& S8 t$ |
* f2 O  t3 c, M; W  @
For i = 0 To NN - 1
9 v2 r+ q2 j5 q, e8 a4 tExcelSheet.Cells(i + 2, 1) = px(i)4 J" E; N. ~  _
ExcelSheet.Cells(i + 2, 2) = py(i)
: T: z4 I6 _" }6 JNext i& e# A) Y" r  q0 o7 t" B9 ]. s9 Z% s! _

! H! c' {1 u5 EEnd Sub

其实，从Excel里面操作，完全也可以实现
只需在excel的 VBA IDE 中的“工具” “引用”菜单选项，选择 AutoCAD 2004 Type Library 对象模型
然后类似的思路编程即可，大家可以试试！

获取标注尺寸函数

Function FixDimMeas(Dimension As AcadDimension) As Long
) c% @% ?6 |) V  h. P* CDim BlockCount As Long
* @% b% j- f4 Z5 E' J6 h1 R" h. ]Dim bz As Long( X& @0 v: C' Z! {+ C

" Z0 K) z& i$ U( B- c7 JBlockCount = ThisDrawing.Blocks.Count
+ Q; g* w0 Q! A# l'遍历块中的对象，取得标注尺寸/ f, s6 Y, W3 b( B3 r% }! i
Dim EntityInBlock As AcadEntity! H; L  h8 ~# k
For Each EntityInBlock In ThisDrawing.Blocks(BlockCount - 1)4 ]% C% g' u6 K  I) m( `
If EntityInBlock.ObjectName = "AcDbMText" Then
: s1 @$ t  j% `0 W# F$ l; ^) }% nbz = Dimension.Measurement
1 s) ?" P+ X1 V. @) W8 zFixDimMeas = bz '取得标注尺寸
# y$ g* `' h- O) fExit For & P& X" c% T4 h6 o9 t4 V
End If
+ e" ]; L! v8 Q( E1 sNext9 [  K2 r& T+ J4 q/ P
End Function

sblisb · 发表于 2011-10-18 19:14:01

这段是在cad中执行,写入excel,偶想改成在excel中执行,写入表

选择CAD线条 EXCEL记录长度 0 D- o( S/ \9 W
选择“工具”\“引用”项，在弹出的“引用”对话框的“可使用的引用”列表框内，选择“Microsoft Excel 8.0 Object Library"项3 w* q4 u" h6 G3 Q( S$ \
0 G  d/ R* L. E" \2 R5 n" x
'计算两点之间距离* C6 T0 e+ L. B
Public Function GetDistance(ptSt As Variant, ptEn As Variant) As Double: ^6 `& a! A8 B4 H; k) y
Dim x As Double( e$ l" j: m0 F! I  g6 H
Dim y As Double5 Y  P& e; w+ u0 ^6 ~+ `
Dim z As Double
# c: q8 Q4 e& P+ `4 j& O* Z x = ptSt(0) - ptEn(0), u! W7 |( `0 u$ H: i  f
y = ptSt(1) - ptEn(1)3 ]9 m8 G0 j" c3 h! C9 O3 C$ ?( b
z = ptSt(2) - ptEn(2)
* w, Q. j) d, ]5 R! E3 u. o! i: _1 G# P GetDistance = Sqr((Sqr((x ^ 2) + (y ^ 2)) ^ 2) + (z ^ 2))3 u. y8 {1 O: E# P3 a" }
End Function$ |$ b9 l8 \3 b. h5 _. X+ P1 {% Y3 h
; [# x6 ?+ _+ l/ s, n+ {
Private Sub xz()7 B' u. b2 ]4 b* _) l3 l  `# M/ S/ @
'创建选择集( f% z: W6 \9 c6 O) e* P" g
For JJ = 1 To 10( J6 l& Y% m8 ^8 G! @5 }
If MsgBox("是否继续选择", vbYesNo) = vbNo Then
. C# }4 B/ k$ {/ q Exit For. s  i5 w: a; l
Else
: O" ~* w. {$ C$ f* w On Error Resume Next$ R6 F  S8 @0 p/ A% F
Set myyactiveDoc = ActiveDocument2 K+ G: o8 w: ^. O

6 K$ o- n$ `! m, j Dim SSet As AcadSelectionSet
% `3 }' C& I* J. h3 e8 E" _    Set SSet = myyactiveDoc.SelectionSets.Add("Ehlxz")4 n2 g4 a% F, g* u2 w/ V8 S
If Not IsNull(myyactiveDoc.SelectionSets.Item("Ehlxz")) Then
/ t- l- E/ M  v0 z2 W& h1 K& K) j" @       Set SSet = myyactiveDoc.SelectionSets.Item("Ehlxz")
2 s: [5 R! p9 y& r7 G* p3 z) H# ?       SSet.Delete    '及时删除不用的选择集非常重要
5 _' M2 A2 V- @1 V End If# `- H5 \+ s. Z/ D% b. _) w  _
Set SSet = myyactiveDoc.SelectionSets.Add("Ehlxz")8 s$ m+ j6 D' D1 S
SSet.SelectOnScreen1 y- h) A3 P! h- @. H4 N
'创建点组) ~. k8 M  T1 X# Q, G7 N" I5 z
Dim ptArr1() As Variant
, o7 u" Y8 U0 M% y Dim ptArr2() As Variant
: a+ L1 h% I" c  g8 k Dim count As Integer
2 R0 l+ \+ ~" g  A6 A. l count = SSet.count' U% D: z; C, _
ReDim ptArr1(count - 1)) d5 O; A& ?, [3 z
ReDim ptArr2(count - 1)% K6 w& I# w0 Z5 r( z0 i2 @+ m
'错误判断
& w: j/ |, g5 a4 N" z% M If count = 0 Then# X' g( Q; q$ [8 D; c/ k  b
      MsgBox "未选择任何对象！", vbCritical0 E5 \$ W: l5 z3 }' Q- p$ b
      Exit Sub
! T: U( n$ q/ I; ~ End If
3 J/ ^9 [. R% `" Y7 y/ D2 I" `
( S+ R+ Z, A# n '获得最左侧和下侧的角点8 V) Q: k2 }# _$ j, P2 K
Dim objEnt As AcadEntity
( L5 x" L( {" D: X& c Dim ptTemp As Variant
& r( o& C0 f4 D( O9 r) \ Dim i As Integer
" q& Y" x( D! a" ~ i = 0
6 s. |1 ^* ~0 d* I9 w& K1 f& U For Each objEnt In SSet0 f' h7 P% c# P3 D5 K
      objEnt.GetBoundingBox ptArr1(i), ptTemp$ t  K- I: P7 ~! H4 j
      i = i + 1& T+ S6 i: Q' o8 i; Z
Next, f- x1 P' L- p  C4 F! N
'获得最上侧和右侧的角点
8 u; ?8 n# R9 l! j3 ^* ^4 A i = 0
8 X3 o5 @; r* z For Each objEnt In SSet
' E1 H1 I  ~8 [! q3 D       objEnt.GetBoundingBox ptTemp, ptArr2(i)6 c8 ?$ H. ~% i) t) c. S
      i = i + 1
3 B" `0 [7 [3 p5 z Next
+ G+ T( {8 x. s6 W! ~ Dim ptLeftX, ptLeftY, ptRightX, ptRightY6 P# ~/ \1 x4 E+ L' k2 n: u
Dim ptRight, ptTop% r! I$ e. b. B7 }' |
For WWW = 1 To count
8 ^& N6 v( R) U% `    ptLeftX = ptArr1(WWW - 1)(0)" \% j, _) x- x$ }
   ptLeftY = ptArr2(WWW - 1)(1)
5 o# I+ z9 Q4 g& E" d' {# }    ptRightX = ptArr2(WWW - 1)(0)" e+ k2 b0 C4 p
   ptRightY = ptArr1(WWW - 1)(1)' F, t, @* \' I/ d7 d& }
" M! J4 s9 b8 Y, z
Dim pppt1(0 To 2) As Double
; E* i- c8 L2 @ Dim pppt2(0 To 2) As Double0 E/ X* p. I3 }% \
      pppt1(2) = 06 R; ]4 f" N' Q9 V, T/ C
      pppt2(2) = 0' V0 r$ u2 f5 }6 j* @' I3 x
Dim gzkuan As Double, gzgao As Double) q; S9 u' O1 @  g0 g
   gzkuan = (ptRightX - ptLeftX - 25 * (Int(Val(HjigeCb.Text)) - 1)) / Int(Val(HjigeCb.Text))
2 l8 Z& D( t7 Q9 @' y7 |    gzgao = (ptLeftY - ptRightY - 25 * (Int(Val(SjigeCb.Text)) - 1)) / Int(Val(SjigeCb.Text))/ z* ^/ s/ l- L# E
For j = 1 To Int(Val(HjigeCb.Text))
% q2 z/ j2 W7 P2 X; P/ e    For k = 1 To Int(Val(SjigeCb.Text))
: x- b2 x5 e+ T# A( t9 n4 f, l: l0 M       pppt1(0) = ptLeftX + (gzkuan + 25) * (j - 1)
. Q2 p* w9 L. L) ^& D$ Q! Y       pppt1(1) = ptLeftY - (gzgao + 25) * (k - 1)
6 a3 u' W: p8 Q& T: {4 c* h/ ]       pppt2(0) = pppt1(0) + gzkuan
0 g& d9 K7 t6 d3 v       pppt2(1) = pppt1(1) - gzgao
# _- g# C7 ?$ ~+ H6 P% w) g: C/ }" |  w6 p! O, B) [
   Next" r! @5 C1 S# W3 z" Z  z: [
Next% s7 t; ^+ W! V/ B
      pppt1(0) = ptLeftX
) a- x& I* q! R$ G6 E; R% s  o       pppt1(1) = ptLeftY6 [  c2 H0 ?: O! s0 x
      pppt2(0) = ptRightX# d. j, ~! o" P
      pppt2(1) = ptRightY
1 w7 a" I/ j: w$ T% {9 _1 y, e  Next* t- h. r1 p4 ?( e% H
SSet.Delete9 P/ n8 V* X, b# }6 C" [( w
KK = GetDistance(pppt1, pppt2)/ U& d5 j, Z9 ^7 e
'在程序中操作EXCEL表常用命令:5 l! _! k4 r% o$ k0 ]4 N
  Dim Excel As Excel.Application
" b" y* D6 A0 _3 D3 D Dim ExcelSheet As Object2 d) H! h! |+ D0 E6 R
Dim ExcelWorkbook As Object
8 W$ m2 }% W3 T" Z. { '创建Excel应用程序实例
8 O% l1 O; t' ^ On Error Resume Next/ X9 {0 [8 v0 o' Y
Set Excel = GetObject(, "Excel.Application")
9 \  q1 L: A9 G5 f+ g If Err <> 0 Then( y* K! \' B3 O/ e0 c
      Set Excel = CreateObject("Excel.Application")
& k/ h. |3 p" u, [! R. b          '创建一个新工作簿
% E0 M& \7 k; }9 g4 {6 \2 y       Set ExcelWorkbook = Excel.Workbooks.Add
1 Y* _7 I1 \! [       '令Excel应用程序可见  d& ]% s9 C9 K; U4 e' X2 F
         Excel.Visible = True
, D9 q7 b0 o+ g7 s  z       '将新创建的工作簿保存为Excel文件+ K$ L7 l: y- \0 Y- d  a1 t. [
         ExcelWorkbook.SaveAs "属性表.xls"
8 u8 R5 k: Q2 O. ~2 f, e' K0 a End If2 U0 S: J/ t9 e; n2 z+ j5 p1 J
'确保Sheet1工作表为当前工作表
* I' i5 V4 N7 J$ B3 ?9 M Set ExcelSheet = Excel.ActiveSheet
. m6 k( C* W" C$ M Excel.Visible = True% m# B, I5 C: y& A$ p0 b  m6 k! i- C
endrow = ExcelSheet.Range("A65536").End(xlUp).Row + 1% I$ \. w' z) G5 f" [$ C3 m
ExcelSheet.Range("A" & endrow) = KK
1 E' T/ ^! `) E. h* R Set Excel = Nothing
2 E! ~; X, ^9 P% O7 | End If
$ U* C6 Y( W- [8 Z  Next! B4 j3 d5 c! M6 G$ |2 `; z
End Sub
' s1 A( U3 J! Z; I7 O
6 a2 |& F7 D( {3 L# j

woaishuijia · 发表于 2011-10-19 07:28:55

1# sblisb
在 Excel VBAIDE 中引用 ACAD 类库,将下面的代码写入 Sheet1 对象代码窗口.
运行代码时必须保证待查询的 ACAD 文档已打开并处于激活状态

, ^; m: w/ d7 A9 s \6 \7 j4 W8 O
Sub A()/ U+ ^% i1 l; i( c
Dim CAD As AutoCAD.AcadApplication, St As AcadState, SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, I As Integer
# {' `, r0 T h6 J" W; G
On Error GoTo 10- f9 L l/ O& c8 I2 X; @
'获取ACAD进程
" I' O- k7 ^3 V: L
'类名称最后的编号按版本) ?9 d+ P9 i* O+ ]: _/ p
'R14版本为148 X- H; s4 A) ?: F0 O! [" b
'2000~2002版本为15
$ r" w, u! q; I& z3 O
'2004~2006版本为164 k- s: M! Y Q+ G, K' y, L$ P
'2007~2009版本为17- b9 i' l2 G& t1 l
'2010~2012版本为181 x( i6 p$ Z) Q, Y" H/ s
Set CAD = GetObject(, "AutoCAD.Application.18" )
& r& g9 P$ D' j( _; ^6 P
'获取当前ACAD进程的状态7 M$ _( w9 i% P* C! x# V$ U
Set St = CAD.GetAcadState/ t) _! t9 J6 K! o$ ^
'当ACAD进程空闲时查询直线长度% L2 R+ r7 O) h3 H4 Y& r; B. P
If St.IsQuiescent Then4 T. Q- H7 e! Y, S: Y) }
'创建选择集
2 O* B) d1 ^- b
Set SS = CAD.ActiveDocument.SelectionSets.Add("SS" )
( o- t- x z, i7 I4 U. m+ f
'定义选择集过滤器为只选择直线3 m! q% N/ ]5 {4 a
Fd(0) = "Line"
, K& G5 \$ }6 N! X
'用户在窗口选择
" ^* {/ [- u" N1 L% `3 Z- M: a" N" u
SS.SelectOnScreen Ft, Fd5 |4 @ w1 p- ]! z3 n$ F/ ~1 J8 z7 Q! N
'逐个提取选择集中直线的长度并写入本工作表A列
( T4 e8 L6 j6 P T7 U7 ^
For I = 0 To SS.Count - 1! i$ j0 P: ?" x( T( \
Sheet1.Cells(I + 1, 1) = SS(I).Length* b& {8 h$ G/ }- y
Next. G5 t/ l# H; X7 v7 [
'删除用过选择集" b: k/ S3 G+ S& f4 `- h C. @7 J
SS.Delete' r1 y1 L! K6 i8 q0 w! ]2 i; n( r
Else
% D# {% j- _# B5 \ y8 m7 s
MsgBox "ACAD正忙"- o$ q, Q1 w5 o, n2 T1 P
End If/ a) f- P4 s* N8 U6 N( `
10: If Err Then MsgBox "ACAD没有运行或没有活动文档"
; X4 q0 {4 b7 P, x
End Sub
' d. t% R+ P4 p" a& H7 w. _1 f

复制代码

sblisb · 发表于 2011-10-19 21:59:11

谢谢!
能不能帮助改进两点:
1 数据写入A列时不覆盖A列原有数据.
2 运行程序后自动转到Acad界面,原代码运行后,是在等待状态,还在exce界面,要自己转到Acad界面

279491611 · 发表于 2012-5-3 12:49:33

厉害，学习学习

清风香客 · 发表于 2014-9-23 10:33:43

果断留印，方便后查。

玉紫玄 · 发表于 2015-1-8 13:29:37

学习学习

		自动登录	找回密码
密码			注册

通知

[已答复] excel如何得到线的长度?

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

浏览过的版块