|
|
首先声明,由于对楼主所在行业一窍不通,只能通过楼主在帖中提供的信息来推测符合楼主要求的规则和方法,错误和遗漏在所难免,还望谅解,以下内容仅做为意见和建议供楼主参考:( I% i: H/ O' |- c; N l/ _+ W
一.由于楼主要求用EXCEL输出,所以用LISP是不合适的,这是VBA的长项;! v+ h/ i- v; {7 ?9 {& ]
二.楼主在"2.jpg"中提供的数据样例,疑似来自B1K46+360,而不是B1K46+350(详见附图)6 J% h; P, }" c/ g
" C# s+ |. P4 n( `
% s B) X% H# u: i 以下按此数据来自B1K46+360看待;
/ z" I! x$ q( I三.初步拟定规则和方法如下:
* x( R( W6 G1 j- R6 C% B 假定:3 A9 h6 ~. _5 T; D% V
1.所有需要处理的图形和注释都在已打开的当前DWG文件的当前布局,且所有图形和注释都在WCS的XY平面上,都是二维的;
! x4 c0 K, f$ e- p2 J 2.位于"zhix"图层的所有直线都是某个横断面唯一的"路面中心"线,且所有横断面都有一条"路面中心"线;8 _% B+ ?) V3 L$ a! U
3.每一条"路面中心"线都对应存在一个或多个Y座标小于"路面中心"线下端点Y座标的,位于"shuju"图层的单行文字,其中与"路面中心"线下端点几何距离最近者是该断面的"桩号",按其全部文字内容输出"桩号"数据;
% @' `- ^! [* L7 W 4.每一条"路面中心"线都有一条且仅有一条代表横截面的位于"sjx"图层的二维多段线与其相交;9 f! @9 |, y1 H4 O* \
5.由于在图上测量得知"路面"部分最大斜度为1:0.03,所以,该多段线中角度为±0.05弧度,π/2±0.05弧度,π±0.05弧度和3π/2±0.05弧度的线段均不予理会,其它线段做为"边坡"看待,并按其与中心线的水平位置关系输出其"左右"数据,按其实测长度输出其"长度"数据,按其角度的余切值的绝对值输出"坡率"数据;" E& p! _* M) l/ L
6.输出的"xls"文件的路径和文件名,除扩展名外其它都与"dwg"文档相同- q* B" n3 o9 i( u( i. B
四.按以下规则编写的VBA代码如下:* p- J( s% }, S* h2 ]
5 ]3 `# Y+ n0 y! E' c- Sub HDM()+ x! H+ l( w' {' A; c; Y4 F& c
- Dim Excel进程 As New Excel.Application, Excel文档 As Excel.WorkBook, Excel工作表 As Excel.Worksheet, Int行号 As Integer
- L; o# W( _# D" R - Dim Ss中心线 As AcadSelectionSet, Ss多段线 As AcadSelectionSet, Ss文字 As AcadSelectionSet, Ft(1) As Integer, Fd(1) As Variant
: c. a2 ?! K- H - Dim Lin中心线 As AcadLine, Txt文字 As AcadText, Ent多段线 As AcadEntity2 Z3 m2 S- B: ^% U
- Dim Var中心线下端点 As Variant, Dbl文字与中心线最小距离 As Double, Dbl文字与中心线距离 As Double, Str桩号 As String
9 m" Q3 N8 u/ j- ~8 z" l2 X - Dim Var中心线与多段线交点 As Variant, Var多段线顶点 As Variant, Dbl线段起点(2) As Double, Dbl线段端点(2) As Double, Dbl线段角度 As Double
- Q j3 c8 m1 a1 J. p - Dim Int循环变量 As Integer, Int循环步长 As Integer
, s8 l+ V/ ~8 X - On Error Resume Next
$ v0 S, V( e7 r: n$ ]4 F0 g v - '创建三个选择集,分别选择中心线,横断面多段线和包含桩号的单行文字: w o% B4 o5 W
- With ThisDrawing.SelectionSets" Y( P# Z" `5 I2 e r
- Set Ss中心线 = .Add("中心线")( \8 G6 i: X" G# v. s& O7 p
- Set Ss文字 = .Add("文字")
. _ r7 |) t* U! u6 I5 k3 f - Set Ss多段线 = .Add("多段线")
4 \) e5 F L7 x1 M& O - End With( `, z8 ]1 Y, c2 z
- Ft(0) = 02 P5 ]0 i. T2 \& x8 {; T) {
- Fd(0) = "LINE"/ Y0 G" A9 f3 I# Y3 T
- Ft(1) = 8
. r8 }& K" K, s$ B. F. [; l - Fd(1) = "zhix"1 k( x! e( ~5 L$ l
- Ss中心线.Select acSelectionSetAll, , , Ft, Fd B6 k# T' d. }) O* k- q; d
- Fd(0) = "TEXT"7 j/ r# k' L" H( f7 a
- Fd(1) = "shuju"/ ]! W. c: \$ f- O' w
- Ss文字.Select acSelectionSetAll, , , Ft, Fd$ @0 s- z, K4 W) y
- Fd(0) = "POLYLINE,LWPOLYLINE"8 }- N; B6 B0 o
- Fd(1) = "sjx"
+ Z( U5 H3 S6 r" n - Ss多段线.Select acSelectionSetAll, , , Ft, Fd6 r* R! {6 h9 c0 J+ |7 S4 _! N p1 h
- '创建新EXCEL文档, _# \4 w& `) L& ]( F4 j
- Set Excel文档 = Excel进程.Workbooks.Add
4 G+ i/ ~/ S& \- M4 |$ R$ g. [ - Set Excel工作表 = Excel文档.ActiveSheet* y f6 ]: N1 K
- With Excel工作表
5 X% s; \- D. Y; h3 x* G - '修改工作表名称,并在第一行写入表头文字& m7 f& s0 _+ _ c0 D0 e
- .Name = "横断面数据"$ l( i2 w W' v- d
- .Cells.Item(1, 1) = "桩号"
9 D* A2 p1 y+ D. S - .Cells.Item(1, 2) = "位置"7 @- q" g" ~1 t& f- r
- '合并单元格1 P1 Y! |, x$ l0 m* f- P/ _
- .Range("B1:C1").Merge+ H) O- w- | z) R' P3 B# Q
- .Cells.Item(1, 4) = "长度"* z" }2 K9 d1 t0 Y
- .Cells.Item(1, 5) = "坡率"
/ T4 E# K: y9 Y% e" T- u - '设置单元格对齐方式为水平中心对齐
) g% x& x2 U* s+ } - .Columns("A:E").HorizontalAlignment = xlCenter+ X8 z$ p& C) z% j: C8 f
- Int行号 = 1: V3 p; ~2 [# Q' `/ Y" E& x3 g# C" Q
- With .Cells
% ?9 r/ d) b5 C# G - '遍历中心线' b. K3 b' t! ~% Y
- For Each Lin中心线 In Ss中心线
c- E6 o2 E. d9 `4 ^* t2 q! L - '提取中心线下端点. N; m: j. _ _: P4 G \
- If Lin中心线.StartPoint(1) > Lin中心线.EndPoint(1) Then
- a4 Y; u0 L6 Y! V - Var中心线下端点 = Lin中心线.EndPoint( |: V6 t( B* {" M/ U |& U6 ?
- Else, Q$ e* q) P/ Q3 W U y8 s
- Var中心线下端点 = Lin中心线.StartPoint+ I8 R- C% [/ A" P0 Q. b8 a
- End If
|. y) b+ g6 C - '遍历单行文字,找出与中心线对应的桩号并记录
% V! O9 x+ t9 e0 l) s; D, P+ R - Dbl文字与中心线最小距离 = 0
, d9 P( o+ e7 |# z - For Each Txt文字 In Ss文字
8 O% L0 M: R( ~" a' _ - If Txt文字.InsertionPoint(1) < Var中心线下端点(1) Then1 a `5 i) ?+ a/ m! ?4 _) Q+ E
- Dbl文字与中心线距离 = Sqr((Var中心线下端点(0) - Txt文字.InsertionPoint(0)) ^ 2 + (Var中心线下端点(1) - Txt文字.InsertionPoint(1)) ^ 2)
* ?9 F5 n( b( g3 W - If Dbl文字与中心线最小距离 = 0 Or Dbl文字与中心线距离 < Dbl文字与中心线最小距离 Then) Q8 e7 ]. Z( U" l
- Dbl文字与中心线最小距离 = Dbl文字与中心线距离 F# c5 h" V9 y" y" Y
- Str桩号 = Txt文字.TextString' M6 k& d8 t# a( V0 M {
- End If* y! A, A; T, c$ i% e& R
- End If
- s' D4 @$ V5 m% }2 C6 @* G - Next
- v% i( S6 T& q( T: Q) V, e7 n - '遍历横断面多段线
b) g' r1 G& A; n1 r4 | - For Each Ent多段线 In Ss多段线9 V% g& B( ]5 |" x3 G8 s" `
- '检查多段线与中心线是否存在交点,如存在交点则输出数据' T8 Q; v9 v1 P' ~$ y# b7 V X
- Var中心线与多段线交点 = Lin中心线.IntersectWith(Ent多段线, acExtendNone)
& B& e1 F6 ?$ ^( c) U% o - If UBound(Var中心线与多段线交点) > 0 Then
) H: d0 r' y: Y* Q t* ?8 A; P/ r8 e - '提取多段线顶点坐标! q4 H: }5 S* c' S5 w( ^
- Var多段线顶点 = Ent多段线.Coordinates
3 e3 m1 G; _* b - '按多段线类型选择读取坐标的方式6 U/ ^+ [1 F' @- R _
- If Ent多段线.ObjectName = "AcDb2dPolyline" Then
* v* t4 E n M5 g) X* A - Int循环步长 = 3
I! b W8 k, ]$ y B4 s - Else
8 ~7 z9 |3 e# k- M e2 m - Int循环步长 = 2
1 {/ [0 j$ [: h- T7 X - End If7 e6 ^. D: k, `" M9 X* b
- '从第一个顶点到倒数第二个顶点,逐点检查相邻顶点间线段的特性
9 D# j( w9 w0 N( n - For Int循环变量 = 0 To UBound(Var多段线顶点) - Int循环步长 * 2 + 1 Step Int循环步长( K: y2 ~2 t6 ^
- '提取线段的起,端点2 x" \, r- W7 w: @: d% C0 J- K/ W
- Dbl线段起点(0) = Var多段线顶点(Int循环变量), m2 c' c0 A& a' V
- Dbl线段起点(1) = Var多段线顶点(Int循环变量 + 1)
7 _4 w1 M$ L- c" A' a& t$ a- K - Dbl线段端点(0) = Var多段线顶点(Int循环变量 + Int循环步长)
$ i0 I- }. v( U& U - Dbl线段端点(1) = Var多段线顶点(Int循环变量 + Int循环步长 + 1)7 u8 P9 r- C4 A% q
- '提取线段角度
. j; L. g j! o x7 j' B - Dbl线段角度 = ThisDrawing.Utility.AngleFromXAxis(Dbl线段起点, Dbl线段端点)) M, L' k. [3 V& `5 x, X
- '检查角度是否为"边坡",如果是则输出数据! [! U% r5 v+ k4 L! b9 d( A
- If Dbl线段角度 > 0.05 And Dbl线段角度 < ThisDrawing.Utility.AngleToReal(90, acDegrees) - 0.05 Or _" C0 m: _. X. e
- Dbl线段角度 > ThisDrawing.Utility.AngleToReal(90, acDegrees) + 0.05 And _! `5 G) V$ z% j: _
- Dbl线段角度 < ThisDrawing.Utility.AngleToReal(180, acDegrees) - 0.05 Or _
. z2 n( N% s% c% N2 M - Dbl线段角度 > ThisDrawing.Utility.AngleToReal(180, acDegrees) + 0.05 And _" ]8 J D9 P. ?+ Q8 O
- Dbl线段角度 < ThisDrawing.Utility.AngleToReal(270, acDegrees) - 0.05 Or _: ^& M) S4 f$ z
- Dbl线段角度 > ThisDrawing.Utility.AngleToReal(270, acDegrees) + 0.05 And _
+ ^/ X# |9 g' C - Dbl线段角度 < ThisDrawing.Utility.AngleToReal(180, acDegrees) * 2 - 0.05 Then2 \) Y _7 N- f$ p% G0 P
- 'EXCEL工作表中行号递加$ Q3 w! c6 i9 {1 a& D
- Int行号 = Int行号 + 1- ^8 F$ h- ] d) { ?
- '写入前面记录的桩号
" S' `9 k+ p/ T - .Item(Int行号, 1) = Str桩号& x* l( ~9 b% Z% |5 V! H
- '判断该线段与中心线水平位置关系,并写入"左右"$ H; i/ U3 ?8 X9 Z# o/ K* l) e
- If Dbl线段起点(0) < Var中心线下端点(0) Then/ G3 ^& ^& r1 X! V- e0 m" ~" p
- .Item(Int行号, 2) = "左"
1 ^+ g2 i- g; v) ~% x# M/ R - Else
2 \( A A8 x7 J8 i. O; b - .Item(Int行号, 3) = "右"5 e: F( Z$ F2 Y
- End If
; j; |' u8 m: H, f: ^6 v" h8 E - '写入边坡长度
1 p8 w& c$ P: i! R - .Item(Int行号, 4) = Sqr((Dbl线段起点(0) - Dbl线段端点(0)) ^ 2 + (Dbl线段起点(1) - Dbl线段端点(1)) ^ 2)
1 m- L/ M4 @- a/ C/ m t f7 w - '写入坡率
B+ n! ^3 |3 T+ e- S, | - .Item(Int行号, 5) = Abs(1 / Tan(Dbl线段角度))
7 V1 f7 ~3 ` } - End If
! t: s4 P# \/ s6 J - Next
' e9 |' I. W# j H& i+ I - Exit For; G6 Y# |! W; n, a7 s5 x
- End If
% Q: h/ T! w" K - Next/ {2 V1 }# D- }( W+ G
- Next1 p. C0 _2 V* Y% O
- End With9 J, b" S5 v: n6 H1 `+ A
- End With4 @! M/ B; [: x1 F( r; X q2 d* h( ]. `
- '删除用过的选择集
! N p2 q& F; V4 M, o2 v - Ss中心线.Delete
' y! W& y8 _; |$ d% T$ b/ r - Ss文字.Delete9 T( w J( u' z+ A0 I
- Ss多段线.Delete
5 Q `3 F4 a k) V - '保存EXCEL文档并退出
4 p. O/ D, o2 K - Excel文档.SaveAs Left(ThisDrawing.FullName, InStrRev(ThisDrawing.FullName, ".") - 1) & ".xls"9 R, Z( R. i# q+ z$ H6 i& \+ a
- Excel进程.Quit/ V7 H/ e% a9 J/ _, F7 W
- End Sub3 C/ x/ v6 U& E) J* q$ ]9 M( Y( d
在使用此代码之前,务请在VBAIDE界面的"工具"菜单下打开"引用"对话框,正确设置对EXCEL类库的引用.
* P5 O" {5 K" X五.附件是包含上面代码和对EXCEL的引用的dvb文件,由于本人PC中安装的是EXCEL2003程序,如果使用者的EXCEL版本与本人不同,请自行修改引用.0 a5 @+ n" y. w' g
+ X7 L k6 S5 B- D; B[ 本帖最后由 woaishuijia 于 2010-2-27 06:05 编辑 ] |
本帖子中包含更多资源
您需要 登录 才可以下载或查看，没有账号？立即注册
x
|
发表于 2010-2-17 02:23
楼主
哪位高手帮一下忙嘛……不然太累了
