excel如何得到线的长度?

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

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

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

x

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

在EXCEL VBA编辑器的“工具”菜单中点“引用”，在“引用”对话框中找到ACAD类库，勾选它，确定。见图; Z  k- i" ^3 B) `# y1 m  B
4、在EXCEL VBA编辑器Sheet1对象代码窗口写如下代码, @0 a; c& o9 U5 F* L
Sub A()
" M; R/ r7 L7 Y# K% N5 {# ^! m
) ~0 @7 i8 B  u- ]0 U1 rDim CAD As AcadApplication '声明一个AutoCAD应用程序对象
7 X) o5 \2 z* @, i; tDim DOC As AcadDocument '声明AutoCAD文档对象
- H% j7 X5 I* F0 YSet CAD = New AcadApplication '运行一个新的AutoCAD进程
  X  w, x# E9 n5 ~( c2 XCAD.Visible = True '使运行的AutoCAD程序可见。如果没有这行，程序将不可见，就是说看不见CAD窗口，只能在Windows任务管理器看到有CAD程序运行
# O  `' o$ e4 c% LSet DOC = CAD.Documents.Open(Sheet1.Cells(1, 1).Value) '按照“Sheet1”工作表第一行第一列单元格的内容打开文件# F4 c' }% d' E; m8 a) F& ^5 F5 j
DOC.SendCommand Sheet1.Cells(1, 2).Value '按“Sheet1”工作表第一行第二列单元格的内容向CAD命令行发送命令
8 W& s( S- x$ ], Esub

;;;=================================================================*
' D( Q3 j  T  O! X: `;;;功能：测量线的长度 */ T, R% g' A4 o0 `$ X) X2 D
;;;日期：zml84 于 2009-05-21 17:45 *
& J7 D( _) h  I' ~2 w7 Y" m(defun C:cd ()8 l  K- A" G" v% c
(princ "统计线段长度"% ?. q4 S- i" Z( f
(if (setq SS (ssget '((0 . "LINE,ARC,CIRCLE,ELLIPSE,*POLYLINE,SPLINE")), h  `0 ^: c! B& |8 G1 i6 d# k0 ~
)
5 E* E! q3 Y7 t+ ?; p2 @. z)
* ?" V$ L, q) ^8 s# `3 i(progn" P, c9 U9 Y2 t0 ~5 n4 g
;;
! X( F5 H  ~1 h. s' L, U) y( [(setq LST_LEN '()
. R* B" y. M  X. w+ d/ AI 0  f  g. k" O$ w8 C7 P
)7 |) j& k2 `5 s) ?# ?
;;逐个统计
) W/ K3 \" i, g+ e3 F5 Z. v1 z(repeat (sslength SS)
; d5 G5 M1 m; d5 b& G(setq EN (ssname SS I)
  q! G9 g  O% R/ H! c' M4 RLEN (vlax-curve-getdistatparam5 [( A7 M) X9 P! D) O1 \4 a
EN- C! ^( @7 \1 {3 l8 S
(vlax-curve-getendparam EN)
6 f+ a( q% a/ C! h)1 N3 I6 e% x! ~; g( B  I1 c
LST_LEN (cons LEN LST_LEN)
6 R* `* x! M+ K6 U* RI (1+ I)  |2 x, l0 U( ^6 |8 s
)! |! n# N7 O& u- u! A
) / s5 x4 S" ~) V4 @) m; t2 W7 D
(setq LST_LEN (reverse LST_LEN))
. u( s8 S' p7 e5 G! a;;显示输出
: F: i5 @! ]% ^" Q  D; }(princ "\n找到个数：")
+ B5 n# O# N9 l% ^4 K! E( X2 e/ t1 _(princ (sslength SS))( @: {, E7 W0 t3 C- |4 B% [% N
(princ "\n单个长度：")
- L/ f4 g+ u0 H. k(princ LST_LEN)+ K" d" x8 z% Z7 A  ]6 k. C" Z
(princ "\n总计长度："). x9 Y$ y0 m) }# q0 f" F/ Z8 p, l) [
(princ (apply '+ LST_LEN))
; |$ S! b# v1 i/ f, b)
( U1 d6 c* l6 b/ k9 U& }; L# S)' f7 D* {. k" m7 h
(princ)& F$ B) ~* Y  g; t# z
)
8 t9 |$ p6 s! v: d;;;=================================================================*
1 t$ M) X' z% J; B/ L' v6 m2 Y  u;;;(alert' l9 u& @( X+ p6 |
;;; "功能：统计线段长度\n命令：\"CD\"\n日期：zml84 于 2009-05-21 17:45"
* }: N& ]1 @2 H: I* B;;;), A4 |" x9 u" ]; N
(princ)

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

’使用 VBA IDE 中的“工具” “引用”菜单选项，选择 Microsoft Excel 9.0 对象模型$ i' t4 u2 e0 a% s( n
’水平不高，有点罗嗦，楼主可以精简下
  z9 J: h! b/ Z) P  l& E’欢迎以后交流，QQ 42123043
7 p  V- d6 L: L" g9 B; C- APublic Sub 取坐标()
; }$ \# F- O( f- P’把AutoCAD中某一图层“多段线层”中的所有多段线的坐标列出来% [( n; U8 b. f$ d2 Y8 e
Dim PLSet As AcadSelectionSet0 G" _* Z% Y' x( Q  p4 t
Dim pl As AcadLWPolyline
2 P2 ]$ W1 D8 {( o& {' A
- Y# ^0 g5 k& w" L1 b
% F) b+ F% n( x/ E, m; G# dDim ExcelApp As Excel.Application
0 `4 m' c9 G' ]Dim ExcelSheet As Object
( o9 x: K/ n* U0 ?( a5 |Dim ExcelWorkbook As Object: `9 D5 t1 k7 }& {
$ l" N  t( n4 g$ W$ s# e
# _  r. x0 ]! |5 H  P
Dim pts As Variant) \  T" V- P% E$ e

7 E5 N& R! h2 g5 [- ZDim NN As Integer2 c; R1 f/ x' c& V
Dim j As Integer# U  s/ ~1 h. D! y/ `

$ N4 s3 \1 x. }7 j, WDim pn As Integer" `; h$ e7 ?+ J6 ~5 @& ~3 b

% |, k! X- ^. I0 NDim px(0 To 10000) As Double
  v- C* [& f, gDim py(0 To 10000) As Double
9 Z6 C) o1 P) |% L8 p/ `) h! w) UDim pz(0 To 10000) As Double
) d& X  u6 N( t& m5 n- d1 C$ e4 F+ D4 w8 f0 O: S' W1 w+ r

1 y0 R8 V0 F" @) CDim filtertype(10) As Integer& q3 D) k# Q' e1 x4 j; v1 z) V
Dim filterdata(1) As Variant' ?7 i, o2 `! N4 r# N/ o9 Z6 ~& j
# l! A7 e* D8 x$ |* u; [8 M7 T
filtertype(0) = 0 ’ 选择线型0 i. b7 E3 g4 A3 {) u, u
filterdata(0) = "LWPOLYLINE"
8 v; k) x6 W2 o" c6 _+ w9 d/ U. y4 efiltertype(1) = 8 ’ 图层标识，可以根据具体情况改动
7 d0 t+ P1 W) r! Ofilterdata(1) = "多段线层"
8 ]$ N, b& p8 Y( o: l- O0 B% j8 X7 t4 h3 Q* }) G9 i  o) Q( D

7 f* A# T2 D9 L( A: H* u; Z, M" P  y3 S
Set PLSet = ThisDrawing.SelectionSets.Add("pl")
) h% p9 t' R; J" jPLSet.SelectOnScreen filtertype, filterdata
+ \( i0 J. O  j' |7 |7 V9 A9 O0 c0 v, R. h$ ^& V2 v$ b$ M
NN = 03 w  \5 C2 X& I8 E+ A6 q
j = 0
: Y4 w$ A2 K6 A8 |For Each pl In PLSet
; N9 i2 \0 G9 I7 x3 s0 R! {9 j2 X! R4 o1 x% ~: r8 ]
pts = pl.Coordinates! |2 E& O) b- k. H2 x9 d: Z
pn = (UBound(pts) + 1) / 24 @$ }, ?( S" q$ V9 V

! s6 C; ?. q+ P. p6 L- s- BFor i = 0 To pn - 16 `" z* X5 ?( ?; S/ D2 D3 y; x
px(i + pn * j) = pts(2 * i)
# C3 P) O" D/ e' g1 O7 V* {py(i + pn * j) = pts(2 * i + 1)9 h) l& c& s8 B3 i2 n6 o
Next i1 t; e7 F" V, K; @
j = j + 1
6 p+ f; V3 D, lNN = NN + pn
5 c* d0 p! N2 R& K" @7 B, }Next pl
+ s! J: ~$ S! L) m% @1 F
- m* k0 J7 X" KPLSet.Delete' N& X/ ^1 J" L) E2 f$ g  v8 G& r
4 t# }: F0 B- s' i3 k# [
- Y; D/ |. p. m- Y- Q& M+ g
Set ExcelApp = New Excel.Application
( b8 |/ e4 B5 e" S6 c2 q( R9 W8 T' J% Y! Q9 ?
Set ExcelWorkbook = ExcelApp.Workbooks.Add9 X% r* {  g2 @& S* T; n
/ v; }: }2 g# U7 L" j
Set ExcelSheet = ExcelApp.ActiveSheet2 N7 j* G( ]- P
3 C/ a: [8 t3 l. A8 p7 R2 e/ N
ExcelWorkbook.SaveAs "c:\123.xls"' F- n/ N) H& _6 v, A
: x) I# Y4 q$ h2 e' l4 R& q7 k- e5 h+ s
ExcelSheet.Cells(1, 1) = "x"
& w) s4 P* g1 m' m( q5 XExcelSheet.Cells(1, 2) = "y"( p% Y' f8 J8 A
8 |7 B7 l  b+ f8 f* x+ H/ S
For i = 0 To NN - 1+ r, }' S' j& ?2 \$ T$ {4 m
ExcelSheet.Cells(i + 2, 1) = px(i)6 l  J6 e/ z/ U
ExcelSheet.Cells(i + 2, 2) = py(i); \+ d  y! O2 m8 Z
Next i$ H2 R: U- X" C* g6 C4 y# _

: m4 g' n+ S6 u6 L, v- pEnd Sub

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

获取标注尺寸函数

Function FixDimMeas(Dimension As AcadDimension) As Long) D" i- E6 O5 w$ D8 B
Dim BlockCount As Long
& g6 z3 y8 Y6 Q! p' GDim bz As Long
) k8 {' p1 C4 S H* {# f: B/ P7 X" g, F( M
BlockCount = ThisDrawing.Blocks.Count
. C+ M' ^2 q5 j: h5 E'遍历块中的对象，取得标注尺寸
" p+ a( t3 w3 s: e' O( @Dim EntityInBlock As AcadEntity
1 T" _ p4 E5 p( _For Each EntityInBlock In ThisDrawing.Blocks(BlockCount - 1)1 u( r8 k" j! t2 c& R& K
If EntityInBlock.ObjectName = "AcDbMText" Then
8 X% b0 E4 S$ B* f+ }% V2 pbz = Dimension.Measurement5 x$ W0 X, A! f5 ^7 g# @
FixDimMeas = bz '取得标注尺寸6 ?" o, L' M# x! G
Exit For 3 M" R) i+ L+ `: p" K
End If7 k" g/ C# c; q+ }4 `' h: `. }
Next
7 @# o6 I8 N' y0 C* J/ yEnd Function

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

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

选择CAD线条 EXCEL记录长度 - ?; a) r4 n/ V8 u0 L7 X
选择“工具”\“引用”项，在弹出的“引用”对话框的“可使用的引用”列表框内，选择“Microsoft Excel 8.0 Object Library"项
" Z% ]& H* Y* ~3 E6 P1 j
, i7 C: F2 U8 ?5 K9 d'计算两点之间距离! F; Q7 M1 I% M# A2 H
Public Function GetDistance(ptSt As Variant, ptEn As Variant) As Double
8 s/ ?# M: u9 H) Z" } Dim x As Double
/ [& j0 T  J' }% D1 r0 \6 x Dim y As Double% r5 |  @7 i; i) a- r; x8 [! F
Dim z As Double
  Z/ G& H$ j" h: l x = ptSt(0) - ptEn(0)" V! H+ G1 o  u' @9 g9 o
y = ptSt(1) - ptEn(1)5 q( i" @5 w$ p) u. a/ y
z = ptSt(2) - ptEn(2)
- F7 G# B, a: G( I5 m GetDistance = Sqr((Sqr((x ^ 2) + (y ^ 2)) ^ 2) + (z ^ 2))
8 K0 p4 Q- U  o4 tEnd Function$ H- p2 F" J8 W9 x; Z" }4 q+ I
0 q0 [7 K) y0 t4 u9 p
Private Sub xz()
" ?0 |! H8 N  E/ |! W( ? '创建选择集
+ g+ w! L1 L7 d2 d; N# b For JJ = 1 To 10
$ P# f  x2 E9 I; i+ l$ |# ^. z If MsgBox("是否继续选择", vbYesNo) = vbNo Then
" E. Y! k8 ]2 L7 j Exit For
0 f3 |/ @( W  t: Q6 q2 @5 AElse
( L. }5 z# {1 B On Error Resume Next6 Y: |* P. ~6 \6 T" Z
Set myyactiveDoc = ActiveDocument
+ s1 Z- `7 D5 a" W6 {9 A
. [3 l. k5 l. ?6 S/ m Dim SSet As AcadSelectionSet
+ I' j/ V$ I4 g* W9 L1 Y+ c" ^& F    Set SSet = myyactiveDoc.SelectionSets.Add("Ehlxz")
3 r' x% \* f% ` If Not IsNull(myyactiveDoc.SelectionSets.Item("Ehlxz")) Then
  A# v2 o2 e4 D- a       Set SSet = myyactiveDoc.SelectionSets.Item("Ehlxz")
; q( L+ o# O0 f* G       SSet.Delete    '及时删除不用的选择集非常重要
' g1 \* ~/ C1 _ End If
8 H4 M3 v& [0 e6 ?  T6 Z9 W Set SSet = myyactiveDoc.SelectionSets.Add("Ehlxz")
& }  x5 G  Q% ^4 M6 |, ~% Z SSet.SelectOnScreen; T, ?* z  ~' k
'创建点组. @# L4 L: C9 ?0 v* I; z& H
Dim ptArr1() As Variant
# ?$ A2 e8 j9 A Dim ptArr2() As Variant
+ U' X, r8 Z/ {7 L: H! W0 g Dim count As Integer4 ~3 m- f; g- _# N0 ^
count = SSet.count" [0 F2 C6 O& Q$ n
ReDim ptArr1(count - 1)! \, P- I( g  b  m2 ]. J8 a
ReDim ptArr2(count - 1), ~/ B8 R1 Z$ |' f
'错误判断
9 `9 g, h6 o: z- @; z5 z If count = 0 Then3 |% ^& l) U, F9 U$ {. j4 d# ~
      MsgBox "未选择任何对象！", vbCritical1 l: G+ g5 K) W
      Exit Sub
& h) w$ D, c* h5 i: j* q9 r, G End If1 r0 p* G9 R1 O; e. |9 u! L3 r5 ^7 M

4 o5 ]# c6 b/ h$ O4 B+ B, y: H, Y '获得最左侧和下侧的角点, ]- d$ J& J  B  O3 I8 m+ R5 `
Dim objEnt As AcadEntity( k# l: c7 J  T( R% I
Dim ptTemp As Variant
5 i+ k  W4 i- h1 V" p: o Dim i As Integer( i7 H, K5 Y7 N; f
i = 0
& y" E' x. n/ H! v1 T) c For Each objEnt In SSet$ O$ z2 `! e1 q) h
      objEnt.GetBoundingBox ptArr1(i), ptTemp
9 ^( k  E& B: a* ?" H2 o       i = i + 1
/ p1 s; v9 y- K4 v Next1 f5 m' f# F+ a4 @, n0 q
'获得最上侧和右侧的角点
' B$ Z! I7 I) `; M i = 0
) R2 u0 v# g; `: g. G' M2 j For Each objEnt In SSet
" E9 y/ y! e+ c4 Y3 Z0 ~6 ?       objEnt.GetBoundingBox ptTemp, ptArr2(i)" W2 W: }+ n! ^8 c4 d3 B
      i = i + 1
3 n- O) i' v6 N! M Next2 u6 o2 O5 k) k% B5 _
Dim ptLeftX, ptLeftY, ptRightX, ptRightY
* K2 H1 Z/ X7 D. ], N! ?5 ^ Dim ptRight, ptTop3 e+ A9 }1 ^) ~: @1 }' I
For WWW = 1 To count
) Z5 r; E6 g9 T+ G  Y. j: g# t    ptLeftX = ptArr1(WWW - 1)(0)
5 f3 f" {# Z8 L. \! ~( c/ X    ptLeftY = ptArr2(WWW - 1)(1)# S' _/ U7 ^9 c% l% {8 c0 |- z/ d
   ptRightX = ptArr2(WWW - 1)(0)
) [8 j: D0 Y: Y& s    ptRightY = ptArr1(WWW - 1)(1)
% G! D* O8 l! u3 ~% `; q6 x
" P+ n8 L7 o/ g. y* U: B, ~* o4 ` Dim pppt1(0 To 2) As Double
9 i$ A8 c1 L; _4 ]9 ? Dim pppt2(0 To 2) As Double
! B0 J. p4 }) S2 D       pppt1(2) = 05 k9 M& F; ]3 k, H/ |
      pppt2(2) = 0
8 @$ V  M2 b- h+ u* U Dim gzkuan As Double, gzgao As Double
3 `! u. b! H3 ?! a( r9 I    gzkuan = (ptRightX - ptLeftX - 25 * (Int(Val(HjigeCb.Text)) - 1)) / Int(Val(HjigeCb.Text))" l6 o8 \% l' l) R
   gzgao = (ptLeftY - ptRightY - 25 * (Int(Val(SjigeCb.Text)) - 1)) / Int(Val(SjigeCb.Text))
( u3 u# |  @/ R For j = 1 To Int(Val(HjigeCb.Text))! j2 F- e: q* ^* R
   For k = 1 To Int(Val(SjigeCb.Text))4 h" {# \$ t2 V: \4 m
      pppt1(0) = ptLeftX + (gzkuan + 25) * (j - 1)
. [  P( c; c1 W$ v( ]1 @8 W4 U2 @       pppt1(1) = ptLeftY - (gzgao + 25) * (k - 1)
8 M) c) a( u5 d3 z: y       pppt2(0) = pppt1(0) + gzkuan
* c) P" j% ?5 Z/ k* Q% t$ {1 d       pppt2(1) = pppt1(1) - gzgao, ^# F3 t6 z0 r. T/ w8 U3 I% H
; s# T, Z( s6 l8 g" [" q
   Next% c# p2 h, I4 Q. G6 [! F5 c; n1 ]# e
Next
- Z3 D5 w3 H$ D) e  t       pppt1(0) = ptLeftX- \$ S) F4 y4 M+ `
      pppt1(1) = ptLeftY
$ b: {6 c: q0 g  q; n       pppt2(0) = ptRightX
, U- ?: g  N5 F7 F+ F+ s. a       pppt2(1) = ptRightY
2 m7 X. E& b3 d0 K: B; g; g  Next
1 l) `3 r  {9 o1 t SSet.Delete5 c3 f) m& ?4 z; T" p: d& ?
KK = GetDistance(pppt1, pppt2)
: h  N. V( T! V; ^3 i% D'在程序中操作EXCEL表常用命令:
4 ^: {: p/ _1 c  Dim Excel As Excel.Application4 j, c2 B( i; {/ K
Dim ExcelSheet As Object; w+ W7 y* ]0 C8 @* K. a# K" j
Dim ExcelWorkbook As Object
( Z2 I/ T, H( v '创建Excel应用程序实例
& {4 {( |& T3 t3 t9 v On Error Resume Next
& m: {7 b3 J9 F/ `0 q2 u Set Excel = GetObject(, "Excel.Application")
1 ]; P3 @8 B# X% z  a  ]" Q2 O If Err <> 0 Then- w# \( m/ a* g
      Set Excel = CreateObject("Excel.Application")
/ [- R% B1 G! r# k  I          '创建一个新工作簿
- t; v) c, I& J2 U. V       Set ExcelWorkbook = Excel.Workbooks.Add( r, r! Y# O' u4 W+ n) I" ^! O
      '令Excel应用程序可见
; B! O# q) _8 R2 T$ Y0 S- c          Excel.Visible = True
& }; w- ~  \; B- o2 W1 j       '将新创建的工作簿保存为Excel文件2 d; O5 W7 P/ f( A7 H
         ExcelWorkbook.SaveAs "属性表.xls"
7 S; ]# ?; v- @0 q End If% l. o7 U6 M( D0 d6 _
'确保Sheet1工作表为当前工作表
# b! o2 F( T: e Set ExcelSheet = Excel.ActiveSheet
' m9 _, {% R5 d Excel.Visible = True
/ W; q) U) V" w, V endrow = ExcelSheet.Range("A65536").End(xlUp).Row + 15 C. R4 K0 I7 r; }& _; V- _1 v
ExcelSheet.Range("A" & endrow) = KK7 B" i# t" t/ z% s, J( O2 I
Set Excel = Nothing
$ I9 a- ~2 p2 G4 L' J End If2 a  ~! m: W- e0 X
  Next
# v. G! A# v! G2 C1 s# I: oEnd Sub
3 u( @( k9 r1 }* M$ E  [) R# ^" x1 S3 }1 C0 D/ W- r

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

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

# g8 C! h4 j3 a f5 g9 [4 k5 m
Sub A()
) M. o. c0 L" [
Dim CAD As AutoCAD.AcadApplication, St As AcadState, SS As AcadSelectionSet, Ft(0) As Integer, Fd(0) As Variant, I As Integer
) M$ O: x0 V( J( }1 K0 E
On Error GoTo 10! S0 J0 q+ h4 P3 K
'获取ACAD进程
( ~7 S) H& s! G" |. E6 ~. f1 H
'类名称最后的编号按版本
2 u3 p0 ]7 f5 u1 u, }
'R14版本为14; S9 ]8 ]7 I: ]+ V
'2000~2002版本为15; b8 i" l# t. W: L3 ^, z: }0 J
'2004~2006版本为16* d+ m6 r/ M& d) M% U
'2007~2009版本为17; {- H4 `1 n2 {3 r$ g2 n+ C
'2010~2012版本为188 m/ n* U6 ~# q
Set CAD = GetObject(, "AutoCAD.Application.18" )
) Q' D- C. Q$ {6 Y. K" T
'获取当前ACAD进程的状态
4 D c( d) q& F0 U. z) j( W" J
Set St = CAD.GetAcadState( l) ?6 A8 l5 }% W8 v
'当ACAD进程空闲时查询直线长度* h% Z- e! K9 S' H
If St.IsQuiescent Then
2 O( G" M5 V! I
'创建选择集
5 z$ A9 O2 ~6 C( @
Set SS = CAD.ActiveDocument.SelectionSets.Add("SS" )
' `& d7 N8 i' U, E8 q
'定义选择集过滤器为只选择直线# L" h7 L5 X. Q0 o* r+ {
Fd(0) = "Line"
( C% r2 `+ P+ ?+ \" Z- S
'用户在窗口选择
' @8 @; Q" W8 Z' o1 ^
SS.SelectOnScreen Ft, Fd# R# u% r9 s% c0 A2 n
'逐个提取选择集中直线的长度并写入本工作表A列
! q5 \. |( C/ L f
For I = 0 To SS.Count - 1
( L6 \; |) T$ s& x
Sheet1.Cells(I + 1, 1) = SS(I).Length
( s" ?( _9 u( U* }" ~
Next% G: q& |- z' D
'删除用过选择集) {: ]- u$ j$ ~; t* `) B
SS.Delete
' n3 r B% _* f3 d( O$ f
Else3 ~$ \. U# C8 `8 ?3 y/ g+ S' D
MsgBox "ACAD正忙"
7 P+ k+ F" b& l8 S; i
End If4 m* `+ J: o) h* C7 R" ?: O! M9 E
10: If Err Then MsgBox "ACAD没有运行或没有活动文档"( P- A9 T8 a' ^& l
End Sub$ v* r0 \ d" d3 _

复制代码

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

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