excel如何得到线的长度?

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

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

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

x

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

在EXCEL VBA编辑器的“工具”菜单中点“引用”，在“引用”对话框中找到ACAD类库，勾选它，确定。见图
& H; t1 n4 q6 S) ~4、在EXCEL VBA编辑器Sheet1对象代码窗口写如下代码
8 T) T5 a$ Y2 x8 j( SSub A()" B+ F9 `9 u! h- J4 z" Z

, i2 O/ ~% P3 _Dim CAD As AcadApplication '声明一个AutoCAD应用程序对象
- I% j' v6 G) ]/ v1 K: r% wDim DOC As AcadDocument '声明AutoCAD文档对象
9 a5 ~0 Y S+ N7 ISet CAD = New AcadApplication '运行一个新的AutoCAD进程0 L! g3 D9 c' c; C) [ C* s6 d' w
CAD.Visible = True '使运行的AutoCAD程序可见。如果没有这行，程序将不可见，就是说看不见CAD窗口，只能在Windows任务管理器看到有CAD程序运行
6 P1 }2 N" T7 SSet DOC = CAD.Documents.Open(Sheet1.Cells(1, 1).Value) '按照“Sheet1”工作表第一行第一列单元格的内容打开文件
0 C. p+ i' H' w o* LDOC.SendCommand Sheet1.Cells(1, 2).Value '按“Sheet1”工作表第一行第二列单元格的内容向CAD命令行发送命令
4 {, ~. _% R( U: e5 X8 wsub

;;;=================================================================*- Q3 J" {3 J1 Z, [0 X
;;;功能：测量线的长度 *1 e1 \3 t- U' ?$ I
;;;日期：zml84 于 2009-05-21 17:45 *
% j1 @3 |" y, l1 f  N(defun C:cd ()
6 q" U6 F1 Q) ?* E1 N(princ "统计线段长度"
& H. ^6 q1 |7 d8 C( Z' t; n% l2 `; B1 R(if (setq SS (ssget '((0 . "LINE,ARC,CIRCLE,ELLIPSE,*POLYLINE,SPLINE"))# O' b# t# k; j3 B' [
)
- I2 Q, v, W+ [( Y) `6 z)( U% i. w7 O7 n8 x5 G
(progn
* e3 D4 F' R* A2 l) |" k! K: @;;
, Q) r0 z" X/ U- n3 p3 z7 X(setq LST_LEN '(), R1 F; @/ t/ [1 c4 [9 `
I 0- t+ O) F% J: C4 K$ e% Z+ b
)0 k1 t$ [0 }; T2 A& P4 l; E7 H1 r
;;逐个统计
  @/ _: n' Q) s" P( O9 J0 S4 X9 l(repeat (sslength SS)
+ S( U; b5 _3 @9 ?(setq EN (ssname SS I)
9 L% T% G! t9 ?& ]' y+ [/ `LEN (vlax-curve-getdistatparam
0 R' I0 o9 B1 q4 k4 b/ k7 n0 y2 mEN
6 K! D7 K! t$ P7 @+ L1 J& Q% t) g$ H(vlax-curve-getendparam EN)
7 g# \8 r+ I  ]# B. K)
3 z/ ?/ e8 H6 I8 d. k; R- |LST_LEN (cons LEN LST_LEN)2 Q& h) y- g8 p7 u: y& J
I (1+ I)
3 r: K* N" n4 K" |  Q1 N+ b)
  [) w. x. V; b) K) `)
$ z) i6 Q. L5 \0 J; l* P(setq LST_LEN (reverse LST_LEN))$ o1 b# A- R, P: v
;;显示输出
9 m% G& w7 D, v) U9 @$ F8 f& B" `(princ "\n找到个数：")0 w8 ?5 D8 S2 r
(princ (sslength SS))
7 s2 E3 H5 p: b+ R(princ "\n单个长度："); N" }( y& |) k* j: o  R" W( i
(princ LST_LEN)4 ^& {" |5 c; A" ]9 W- X! A
(princ "\n总计长度：")
: k, l9 s) r1 P6 j/ a: S8 S(princ (apply '+ LST_LEN))
# \9 [' e. S# k  `8 M% [)8 x5 ?  ]+ P' z1 D/ \5 P) ^$ s
)7 r, J2 A* S. V# W8 o/ w
(princ)
; j' \' p$ y& X9 P0 c)7 j3 w  ?. B: X. h$ u* ^
;;;=================================================================*
9 G6 ?' |  l' I;;;(alert
8 v; L7 R$ y+ O4 j' }( };;; "功能：统计线段长度\n命令：\"CD\"\n日期：zml84 于 2009-05-21 17:45"
2 Q! F" d4 p0 i5 A- F. T;;;)& f3 n% n, f7 ?4 t* A9 X8 b
(princ)

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

’使用 VBA IDE 中的“工具” “引用”菜单选项，选择 Microsoft Excel 9.0 对象模型
/ v" m; C. K( M* b: z’水平不高，有点罗嗦，楼主可以精简下+ r, K7 W  W3 H0 w: V
’欢迎以后交流，QQ 42123043" r) y4 u( t2 F' J
Public Sub 取坐标()
9 Y/ \' l  O4 _0 t’把AutoCAD中某一图层“多段线层”中的所有多段线的坐标列出来# m  a3 ~8 F8 e$ W$ g; \
Dim PLSet As AcadSelectionSet1 V7 |4 A3 o9 ?0 k1 f
Dim pl As AcadLWPolyline# `, j) [' d& n- c/ \3 P8 c" O

: l8 M* v2 j+ P3 `- L
+ ^' k( }2 j  I1 y( j* ]5 J0 yDim ExcelApp As Excel.Application+ Z& d7 e8 b" f4 L4 U3 {' Y4 C
Dim ExcelSheet As Object/ u6 ^' _9 g! Y' I, U+ \
Dim ExcelWorkbook As Object/ N& }. e9 T2 [6 I% z
/ ^0 i0 i: m7 v

- q2 R: D% x. iDim pts As Variant. i4 x& k8 t$ n# k( V$ \2 N

! I, M1 @% n4 C. QDim NN As Integer
& d7 D. k3 b' y  s9 jDim j As Integer
& w# Q6 m- q* L) q! q7 |, k4 F' h! n4 m$ f
Dim pn As Integer
8 R" h! H  M+ l, z, w7 Q8 p: N7 j: L3 s: v
Dim px(0 To 10000) As Double+ f2 [) ?7 r. S( o  d9 G
Dim py(0 To 10000) As Double
* k& h+ `7 G1 }0 SDim pz(0 To 10000) As Double
! [2 t8 J- l- p0 R4 u. q2 g0 ?# r: f7 D- o& Y5 [' ~

) I4 X- a. F& s- n; I3 uDim filtertype(10) As Integer$ d" O* l7 X5 m3 q+ O. w1 g5 F, O
Dim filterdata(1) As Variant% \5 W9 |; g# |3 b
! T7 r% _* M! v
filtertype(0) = 0 ’ 选择线型+ w9 t5 E2 l2 D9 u# ^9 x8 n
filterdata(0) = "LWPOLYLINE"2 X0 ~+ W* t# |  |8 B+ F
filtertype(1) = 8 ’ 图层标识，可以根据具体情况改动
1 r/ z9 U, A3 C/ S  W  Kfilterdata(1) = "多段线层"
7 l) E, T9 I$ ?9 G5 B; s8 N9 a$ C3 A) l# z. K/ E

# `7 Y4 q3 a9 d& J2 Z# o3 ]; b# n% [3 O( |
Set PLSet = ThisDrawing.SelectionSets.Add("pl")) k% t5 c5 W# ^; Q* L3 q% M+ M
PLSet.SelectOnScreen filtertype, filterdata: d- E- U" \  G3 {/ A+ s2 X
+ m  a0 x) r2 e- ^
NN = 0
- M8 d9 A% b- qj = 0$ T! g  W1 r0 B1 D' f
For Each pl In PLSet
' \% f+ O+ l! ?& ?. Q
' V2 ~; g' A9 I. ?; m4 ipts = pl.Coordinates+ i! ^. \/ i3 p3 T+ I
pn = (UBound(pts) + 1) / 2
3 J) A2 F* t! `; r" Q$ p8 F, m! X6 Q& s7 D; U- \5 t8 s
For i = 0 To pn - 1
8 r. [. L) ]9 |* Npx(i + pn * j) = pts(2 * i)
2 N7 Z1 i- V$ O3 u/ x" E) Qpy(i + pn * j) = pts(2 * i + 1)# K0 m! J/ n/ b9 v
Next i3 G2 n$ j2 |! p( p
j = j + 1- O' U/ J3 ]$ k0 O0 z) ?; w
NN = NN + pn
- k$ X/ ]% _) r2 k* LNext pl% A) q1 @0 L! O2 B: U( N- ?7 x" K

( S2 ]5 x  ?3 B# `PLSet.Delete
' ^3 g3 ?/ Z, r% X8 ]. j; U) W6 v" l3 X8 j/ ~2 h, m) @

# i5 n4 p8 _/ B$ p' LSet ExcelApp = New Excel.Application
5 h: D! {6 I' w; t
+ u+ L4 v3 q1 N' l! f7 v0 qSet ExcelWorkbook = ExcelApp.Workbooks.Add% W# {5 R9 l1 Y3 J# a6 r

/ M& ?8 _: [+ Z3 e3 N, RSet ExcelSheet = ExcelApp.ActiveSheet
$ m% k  ~) }& y8 s7 ?; U
! u/ b- H; O4 V1 }; R& J9 K+ @8 xExcelWorkbook.SaveAs "c:\123.xls"
7 b: w" s" \( |3 w# }% s9 c0 `- d$ ^  M% B0 I2 i7 v# D
ExcelSheet.Cells(1, 1) = "x"
& `$ H1 s6 G1 z) }: _6 kExcelSheet.Cells(1, 2) = "y"/ r+ v" t  w2 M. p8 ^5 b" F" I5 }; T
6 F# G( M- X5 B. G4 Y. o/ b
For i = 0 To NN - 19 u4 o4 Q/ M7 O
ExcelSheet.Cells(i + 2, 1) = px(i)6 c: k2 S. i- ?3 h4 K
ExcelSheet.Cells(i + 2, 2) = py(i)
# Y4 j) Z. x" z0 Y4 U3 SNext i+ \5 P5 D% Q8 c/ U
: c% a0 k' M( _% C
End Sub

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

获取标注尺寸函数

Function FixDimMeas(Dimension As AcadDimension) As Long% p3 P; g+ A, j
Dim BlockCount As Long' |& C" S* Y7 d) P! Z9 C
Dim bz As Long
% I! B7 _; J4 g+ W% p2 S# _$ Q6 j/ L# T0 S' a
BlockCount = ThisDrawing.Blocks.Count( L% r+ d3 h) [5 n3 ?+ }
'遍历块中的对象，取得标注尺寸' G# f  d* E7 n, q- K
Dim EntityInBlock As AcadEntity/ p5 a8 t9 i" M: X
For Each EntityInBlock In ThisDrawing.Blocks(BlockCount - 1)
" P5 M! b5 s! [4 S1 JIf EntityInBlock.ObjectName = "AcDbMText" Then# b  S' V, r, |' U  H
bz = Dimension.Measurement
/ s) {5 t, Z( v# IFixDimMeas = bz '取得标注尺寸
5 ~3 d5 Z/ |! v7 }% K. @Exit For
5 c" j8 x9 c8 d4 w0 iEnd If
1 v' a* y. j2 n5 c: @3 }Next& t  c2 Y& ^* @& b& e' Z6 D
End Function

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

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

选择CAD线条 EXCEL记录长度 , x2 U2 H! t: S. q. z2 K. U% K
选择“工具”\“引用”项，在弹出的“引用”对话框的“可使用的引用”列表框内，选择“Microsoft Excel 8.0 Object Library"项
4 y: R5 I# k: N$ ~; F) Z% R
' z% ?1 d; d) P% o9 I: ?: {'计算两点之间距离
1 Q3 b9 _* O/ P/ [( s$ u# t* wPublic Function GetDistance(ptSt As Variant, ptEn As Variant) As Double% R1 {! w5 O! |8 [' B3 M
Dim x As Double
9 ~4 y" s- `. l Dim y As Double
* P; J$ [- U, @: H Dim z As Double
/ Q8 z1 z, L' o+ h x = ptSt(0) - ptEn(0)
& o3 ]# m; k. P" s# r0 b+ F" D! d y = ptSt(1) - ptEn(1)) @- g: k$ u( o: [& s  P- {
z = ptSt(2) - ptEn(2)& ?1 F2 S! A7 ^! P5 M% a1 z
GetDistance = Sqr((Sqr((x ^ 2) + (y ^ 2)) ^ 2) + (z ^ 2))
: O. Q! d  J- R4 X2 ^$ VEnd Function
/ s/ b" _! b; [4 p" \ $ I; N- r. T! h4 p& V$ e& u
Private Sub xz()5 s' v$ R% f" G4 ~6 U* ?( L* [' b
'创建选择集' L/ b  z7 F7 h7 R
For JJ = 1 To 10
+ K4 q3 t- a8 v% E! N; S If MsgBox("是否继续选择", vbYesNo) = vbNo Then( y  H+ I/ }( O/ u5 D9 `1 e/ c& G
Exit For( s3 \! Y0 ~  K' b
Else( `4 O; D0 M$ L* n) B
On Error Resume Next
+ m5 ?' I% a4 l, K% z2 t' z Set myyactiveDoc = ActiveDocument
0 m! s) ^  r' S5 V! A" ^$ @( u# G% j5 F. ?
Dim SSet As AcadSelectionSet
, t- {) h- J: C& [5 R& j    Set SSet = myyactiveDoc.SelectionSets.Add("Ehlxz")
# ^% X& s/ i% u- i If Not IsNull(myyactiveDoc.SelectionSets.Item("Ehlxz")) Then
( M% y+ U" q: Z: C3 b. V2 }. {2 s       Set SSet = myyactiveDoc.SelectionSets.Item("Ehlxz")' J; u8 x" h% ~; `. \
      SSet.Delete    '及时删除不用的选择集非常重要1 R& [" t/ c5 M: p' [" E
End If/ l0 ^+ c* w7 ]0 S
Set SSet = myyactiveDoc.SelectionSets.Add("Ehlxz")  Y0 }8 S* n! `3 ?2 ]
SSet.SelectOnScreen% @/ t$ y& ~# ]$ b2 @8 t5 u0 V
'创建点组
" Y, _1 i0 ?5 x4 x' Z Dim ptArr1() As Variant
7 ?; u# S1 D3 l- A: ` Dim ptArr2() As Variant
- e* q9 q* \1 m7 H& G$ G Dim count As Integer
3 P) z, I/ n) f6 Y" d, ` count = SSet.count
- d# o! w1 A+ s1 N; B: W/ b ReDim ptArr1(count - 1)! G5 ^0 l5 J: K; ]' Z# o7 G
ReDim ptArr2(count - 1)
- z+ a2 y$ \  {! k1 R '错误判断
6 S6 e- U) q6 [+ b( p8 s6 c8 w If count = 0 Then
, s. q( J. j# h# V       MsgBox "未选择任何对象！", vbCritical7 Y) d$ {$ `, y
      Exit Sub* P" ^1 u& S1 R- |: z) F1 n
End If8 s$ X* g" v. j( E2 i
! j  D, `' w: R: }" P
'获得最左侧和下侧的角点# W! V( K9 R8 E, }' J5 e3 e
Dim objEnt As AcadEntity. V: d' v, e: L8 H7 x) U, c9 P+ O
Dim ptTemp As Variant
9 S9 |" W# Y+ V1 a Dim i As Integer
! P! Q/ V2 Z' ]( R8 ] i = 0; \9 ~0 A4 S* X- {0 j! N5 Y6 ~: n3 X/ X
For Each objEnt In SSet7 z- ~) T4 i( z- j
      objEnt.GetBoundingBox ptArr1(i), ptTemp
6 {  c0 g" h8 p# d5 d       i = i + 1
' V- F; p2 p# m7 g7 b$ ]5 _7 {7 B: {5 I Next
7 [9 ]" S  T& a '获得最上侧和右侧的角点+ Y4 g/ ~1 r! i3 q
i = 0
2 R# s$ N/ J1 V# A- G4 C( W8 S$ c For Each objEnt In SSet
6 V# c% N! a$ l  X# t, R       objEnt.GetBoundingBox ptTemp, ptArr2(i)
& t( \. J. K& w6 |$ j       i = i + 1% S( j- f$ r; G3 J5 n
Next
$ L( t. j# Q* n* s) U& }& E0 }3 I Dim ptLeftX, ptLeftY, ptRightX, ptRightY, W2 q9 z7 ^+ n( e/ A0 e
Dim ptRight, ptTop) r6 p% B3 A! m- }
For WWW = 1 To count
9 a+ M" i$ t( c5 w' N    ptLeftX = ptArr1(WWW - 1)(0)) `/ K$ u( S8 Y" S
   ptLeftY = ptArr2(WWW - 1)(1)/ Z9 i* A- T8 U6 p. Y' f5 f: j
   ptRightX = ptArr2(WWW - 1)(0)( a& A' O6 c, f% e9 @' C& @
   ptRightY = ptArr1(WWW - 1)(1)
! t' |2 F+ a6 d3 d- ?( y: n * v. E$ \4 K  p; o) N
Dim pppt1(0 To 2) As Double6 [# g5 K1 M8 F& }8 @7 ^  I1 ?- L; B
Dim pppt2(0 To 2) As Double& o4 X$ U' C* g
      pppt1(2) = 0
: M8 \7 M$ o1 ?       pppt2(2) = 0
% U; ]8 q4 f5 F6 q0 N* g/ D Dim gzkuan As Double, gzgao As Double
5 O' h; D+ b  y* r, s    gzkuan = (ptRightX - ptLeftX - 25 * (Int(Val(HjigeCb.Text)) - 1)) / Int(Val(HjigeCb.Text))
" d& W, M4 m: h4 ~* `, N3 m    gzgao = (ptLeftY - ptRightY - 25 * (Int(Val(SjigeCb.Text)) - 1)) / Int(Val(SjigeCb.Text))
6 {* |* P3 a6 t For j = 1 To Int(Val(HjigeCb.Text)). K; k' U$ M# O0 |7 X! @% Q4 ^
   For k = 1 To Int(Val(SjigeCb.Text))+ h: F- G( u& {. K) G0 G/ _& g/ B& h
      pppt1(0) = ptLeftX + (gzkuan + 25) * (j - 1)/ u$ b" w6 J+ S, E1 W9 G
      pppt1(1) = ptLeftY - (gzgao + 25) * (k - 1)
& T, c. p8 e6 O0 c, e       pppt2(0) = pppt1(0) + gzkuan
( _  Q* {/ |$ ]* k7 I- Y8 B0 ~       pppt2(1) = pppt1(1) - gzgao
2 }& c* B% g' E+ h3 w/ ]( U7 @: g( p/ C
* }2 I( T1 \9 D$ W+ L8 @0 u7 o' q    Next+ K! q* x$ r( B8 |/ S
Next
1 R+ s: x8 c, Q7 E, v       pppt1(0) = ptLeftX% T& h/ d% [2 [+ u; e) u
      pppt1(1) = ptLeftY& x1 |: n' t& ^9 Z# B
      pppt2(0) = ptRightX! s! s4 Q1 H; H/ I, X/ `
      pppt2(1) = ptRightY9 ]( A; G( g, ^3 E! E; K
  Next% {0 Y' D0 W8 j# T3 n
SSet.Delete
/ B& I. s) I9 W% h KK = GetDistance(pppt1, pppt2)
+ U1 |# ^( B4 Y'在程序中操作EXCEL表常用命令:- s3 X; G. S& u! K5 w9 |! n" N
  Dim Excel As Excel.Application
4 v% s+ j( w, O# y Dim ExcelSheet As Object
% y5 [5 K: V' j. N# E Dim ExcelWorkbook As Object7 R! a+ o" r6 I9 m2 K/ s9 v3 w* M
'创建Excel应用程序实例
# f, K& \; t; V& v6 o On Error Resume Next
5 b9 @: G( J2 }- U2 u Set Excel = GetObject(, "Excel.Application")
# c) J8 N' Q1 b7 Q# S" Q! L If Err <> 0 Then
. E: `; B8 _9 s- w9 Q; i       Set Excel = CreateObject("Excel.Application")
' {; P; Z0 @$ r3 G# f/ x          '创建一个新工作簿
( e4 m, {3 x$ \3 J" W3 d) b4 G5 W       Set ExcelWorkbook = Excel.Workbooks.Add
# R! y' l, O, Y7 \  w       '令Excel应用程序可见
% B/ V/ K6 @0 V, H2 e          Excel.Visible = True
' z" a; f; G( f# U       '将新创建的工作簿保存为Excel文件0 \+ x  ?8 I7 s1 Q
         ExcelWorkbook.SaveAs "属性表.xls"9 I) L$ _: W9 u
End If
- s, g% h# ]9 ]" |9 N '确保Sheet1工作表为当前工作表) j1 T8 g- d% E. V
Set ExcelSheet = Excel.ActiveSheet0 u  [' R, `5 n
Excel.Visible = True; {) A" W9 B5 }2 [- m* b
endrow = ExcelSheet.Range("A65536").End(xlUp).Row + 1
/ u4 M' T; g$ k- M1 b" m( k2 H5 j4 ^ ExcelSheet.Range("A" & endrow) = KK# R/ _1 l: |: u! l6 @
Set Excel = Nothing. ~- a) Q$ I6 z7 G- h# s' z; n
End If0 H% i5 i4 r; K/ y3 v( i& u" F
  Next9 r! _4 U2 f) L, z* n3 e
End Sub
2 X6 u- u3 I5 t. }6 b# N) a! L# H
$ O& v( E7 ]4 ~+ h

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

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

% t; {! Y" B( c. l; N
Sub A()0 [+ X3 v/ O6 ]: t. O! I
Dim CAD As AutoCAD.AcadApplication, St As AcadState, SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, I As Integer
1 d0 D" Q0 B7 p1 O$ b: W
On Error GoTo 10" M2 V, O, C6 R
'获取ACAD进程
5 N0 o t- p& d) d
'类名称最后的编号按版本$ J. t: E1 j, {5 Z& o
'R14版本为147 X# z1 y3 b- T7 S
'2000~2002版本为15. n, U) E/ t8 O4 A
'2004~2006版本为16
$ j4 e# h' V; _( U4 j
'2007~2009版本为17
& u( L) J, z" R7 V
'2010~2012版本为189 Y- z" r/ e0 y2 J; P
Set CAD = GetObject(, "AutoCAD.Application.18" )
+ i0 c* V% @; d: Z( d" ~
'获取当前ACAD进程的状态$ Q5 F9 n: D! m* I2 f6 x
Set St = CAD.GetAcadState
0 o T- O% T: \% A$ g0 R
'当ACAD进程空闲时查询直线长度/ X" ~2 g- U/ S
If St.IsQuiescent Then" b1 F1 K. w1 y: p
'创建选择集
7 M$ {* B4 G* T# c
Set SS = CAD.ActiveDocument.SelectionSets.Add("SS" )# j! G4 ^9 i; L: K8 f
'定义选择集过滤器为只选择直线
' s5 w0 b' c. K* I; k; ?+ ]9 ]5 k
Fd(0) = "Line"
& j* x; |1 E$ g& K% q3 m
'用户在窗口选择
: t6 F0 l' S5 S, P; b
SS.SelectOnScreen Ft, Fd; W3 V2 A. i% p) f$ d
'逐个提取选择集中直线的长度并写入本工作表A列
3 a5 q: v- P8 E7 V" d/ ^
For I = 0 To SS.Count - 1+ P, |2 N/ |: E, R
Sheet1.Cells(I + 1, 1) = SS(I).Length
0 _1 Z6 v$ B: F8 s
Next6 x8 b# H. h- C7 G0 ]2 A( J( O5 M
'删除用过选择集
; v( E! `1 D# ~
SS.Delete7 ~' O) p6 ?8 e( ]
Else
# A3 i3 @ |: ~1 p1 g
MsgBox "ACAD正忙"# H# }! X6 ?6 n8 X( d
End If/ o+ v7 g' Z; T
10: If Err Then MsgBox "ACAD没有运行或没有活动文档"4 ]2 E) Q* Z& C: B$ h2 n, `$ Y& N
End Sub
* j/ P( b$ |# @( _0 h

复制代码

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如何得到线的长度?

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

浏览过的版块