|
|
首先声明,由于对楼主所在行业一窍不通,只能通过楼主在帖中提供的信息来推测符合楼主要求的规则和方法,错误和遗漏在所难免,还望谅解,以下内容仅做为意见和建议供楼主参考:
6 }$ f$ w6 E D! \一.由于楼主要求用EXCEL输出,所以用LISP是不合适的,这是VBA的长项;
1 Y, Y6 z+ l C$ g7 f二.楼主在"2.jpg"中提供的数据样例,疑似来自B1K46+360,而不是B1K46+350(详见附图)
$ Y) ]6 \1 l& Z) c, B6 q' A5 b
9 I* O' j7 }' Z9 {' E9 c) m5 V
: n/ y2 e) @! E+ Y" F8 o& h 以下按此数据来自B1K46+360看待;
+ v5 M% I$ Z" ?8 F! e; L三.初步拟定规则和方法如下:$ b" T) P- c. J, p4 x. @' W/ G
假定:/ a; W: |3 K5 |& X" G& Q
1.所有需要处理的图形和注释都在已打开的当前DWG文件的当前布局,且所有图形和注释都在WCS的XY平面上,都是二维的;4 e! |9 _9 x# f% j- u
2.位于"zhix"图层的所有直线都是某个横断面唯一的"路面中心"线,且所有横断面都有一条"路面中心"线;
7 j2 O8 q* r- ^$ E 3.每一条"路面中心"线都对应存在一个或多个Y座标小于"路面中心"线下端点Y座标的,位于"shuju"图层的单行文字,其中与"路面中心"线下端点几何距离最近者是该断面的"桩号",按其全部文字内容输出"桩号"数据;4 n& G4 E9 x# `/ p! f5 m- z
4.每一条"路面中心"线都有一条且仅有一条代表横截面的位于"sjx"图层的二维多段线与其相交;; j, e% m1 ]$ x; v- r
5.由于在图上测量得知"路面"部分最大斜度为1:0.03,所以,该多段线中角度为±0.05弧度,π/2±0.05弧度,π±0.05弧度和3π/2±0.05弧度的线段均不予理会,其它线段做为"边坡"看待,并按其与中心线的水平位置关系输出其"左右"数据,按其实测长度输出其"长度"数据,按其角度的余切值的绝对值输出"坡率"数据;
i; C/ d0 f$ q/ U 6.输出的"xls"文件的路径和文件名,除扩展名外其它都与"dwg"文档相同
) N( A; g! j7 D) b' e8 ~% d四.按以下规则编写的VBA代码如下:# N5 v5 _6 ~# M7 M8 E
- % S5 z, J9 y: V& H' w( q9 {
- Sub HDM()
' ^2 a$ n1 E" C: } - Dim Excel进程 As New Excel.Application, Excel文档 As Excel.WorkBook, Excel工作表 As Excel.Worksheet, Int行号 As Integer
6 w6 I6 p1 A8 f0 f/ I4 u - Dim Ss中心线 As AcadSelectionSet, Ss多段线 As AcadSelectionSet, Ss文字 As AcadSelectionSet, Ft(1) As Integer, Fd(1) As Variant
" G# y# W. n X( \9 _5 A/ \2 }; U - Dim Lin中心线 As AcadLine, Txt文字 As AcadText, Ent多段线 As AcadEntity
$ c6 a; [4 @6 |4 | - Dim Var中心线下端点 As Variant, Dbl文字与中心线最小距离 As Double, Dbl文字与中心线距离 As Double, Str桩号 As String8 \% Z% M+ q. R4 H
- Dim Var中心线与多段线交点 As Variant, Var多段线顶点 As Variant, Dbl线段起点(2) As Double, Dbl线段端点(2) As Double, Dbl线段角度 As Double: t. m5 K2 _# i* _; V. u
- Dim Int循环变量 As Integer, Int循环步长 As Integer. q, l% w, v! V3 V
- On Error Resume Next
' p6 f; T0 X/ [6 ~$ f% [ - '创建三个选择集,分别选择中心线,横断面多段线和包含桩号的单行文字& ?2 R9 Q; q) e6 A% Y
- With ThisDrawing.SelectionSets- `! P7 ?; q9 v
- Set Ss中心线 = .Add("中心线")/ Q2 a* |! Y% }: r- ?) z1 f4 [
- Set Ss文字 = .Add("文字")
8 g* `* v" H. C& q9 _# I6 T - Set Ss多段线 = .Add("多段线")
0 R7 \ k5 ^/ e* O, S0 x+ R - End With
- D7 H# _1 ?, |+ e2 k/ _; u - Ft(0) = 0
' v0 l8 Q E! U, G6 K+ o/ ~ - Fd(0) = "LINE": J4 q8 V# ~; O) q7 o
- Ft(1) = 8% ~' G2 n$ M+ ^ Y' M o
- Fd(1) = "zhix"
) J2 S5 H! w' Z8 k - Ss中心线.Select acSelectionSetAll, , , Ft, Fd
/ W# o5 s0 E, o! k4 a6 p - Fd(0) = "TEXT"
/ {* s; Z, m% f - Fd(1) = "shuju"
+ w' O8 |" v/ V! [$ k - Ss文字.Select acSelectionSetAll, , , Ft, Fd. n0 z$ X6 x; W0 i
- Fd(0) = "POLYLINE,LWPOLYLINE"
6 Q0 N: u7 _ y# W8 g- r - Fd(1) = "sjx") W$ I# d5 s% Q6 [* D9 B# y5 N
- Ss多段线.Select acSelectionSetAll, , , Ft, Fd
+ j. B8 V5 e s5 a6 E - '创建新EXCEL文档1 c L0 G! r. X c$ H! P1 m
- Set Excel文档 = Excel进程.Workbooks.Add5 X! w$ h4 m+ _6 E- j
- Set Excel工作表 = Excel文档.ActiveSheet
( E2 W) r. f5 \! K - With Excel工作表" D! ?8 ?* ]2 F- M& v
- '修改工作表名称,并在第一行写入表头文字
! L9 h! n4 o* W* l+ |. r - .Name = "横断面数据"
. x3 H$ f% v* i: t - .Cells.Item(1, 1) = "桩号"4 [6 F P$ x6 z1 _ @0 a
- .Cells.Item(1, 2) = "位置"
2 _7 q" y4 F( i$ E8 ], @" ^ - '合并单元格
/ @6 G4 ]2 Z. |7 _8 Y" Y# |7 a5 \4 F - .Range("B1:C1").Merge3 ?3 H; B$ }2 q5 y( k
- .Cells.Item(1, 4) = "长度"( I* [/ O) A! Q: R! `& `# f
- .Cells.Item(1, 5) = "坡率"
$ `+ y" L6 r' ]& Z B4 p2 Z - '设置单元格对齐方式为水平中心对齐/ J+ u4 A& |( x* s8 B5 M
- .Columns("A:E").HorizontalAlignment = xlCenter/ ?8 L7 X" G& Y0 H' T( A: p
- Int行号 = 1
" L5 G4 p9 A5 w. O- I - With .Cells! d2 b. [5 w0 M: p9 X# N3 n
- '遍历中心线
" Y/ N1 q2 R: |( r2 o7 v - For Each Lin中心线 In Ss中心线
1 _" r) W; b" @+ d; C9 L- y - '提取中心线下端点
5 w( N9 e- q+ j! I4 ~/ X" L: \' |# z - If Lin中心线.StartPoint(1) > Lin中心线.EndPoint(1) Then
1 `, N9 K; g% i; V+ I1 x X" @! m - Var中心线下端点 = Lin中心线.EndPoint6 D" p3 v8 s( w
- Else
2 u6 F1 s$ T8 Y! D2 | - Var中心线下端点 = Lin中心线.StartPoint6 q$ B; Y2 t: c0 t0 l
- End If, b+ a4 f" W* u
- '遍历单行文字,找出与中心线对应的桩号并记录
2 X; y( t9 E+ b8 E - Dbl文字与中心线最小距离 = 09 R6 O9 i: [4 K3 j1 J4 A
- For Each Txt文字 In Ss文字
# z, P! w. e; N - If Txt文字.InsertionPoint(1) < Var中心线下端点(1) Then6 J1 a/ X% q, ~) q: d0 j
- Dbl文字与中心线距离 = Sqr((Var中心线下端点(0) - Txt文字.InsertionPoint(0)) ^ 2 + (Var中心线下端点(1) - Txt文字.InsertionPoint(1)) ^ 2)8 K3 @. C7 [% \. h
- If Dbl文字与中心线最小距离 = 0 Or Dbl文字与中心线距离 < Dbl文字与中心线最小距离 Then
: {8 N6 t' o- Z - Dbl文字与中心线最小距离 = Dbl文字与中心线距离
) D7 o0 `" U+ R. Q5 b - Str桩号 = Txt文字.TextString5 v' C6 }) n2 l7 ^* j0 D; P
- End If# o! |0 i+ P: c, F0 @
- End If' n4 p/ Q/ Y! H+ x( b# q
- Next* w# W; b5 G- p+ I
- '遍历横断面多段线
2 H5 p4 v. _: i1 T - For Each Ent多段线 In Ss多段线
7 s: V X$ i& B& |' \6 R. L- ? - '检查多段线与中心线是否存在交点,如存在交点则输出数据( q3 Y ^7 a# ~( [% y
- Var中心线与多段线交点 = Lin中心线.IntersectWith(Ent多段线, acExtendNone)" M! p$ X2 }; s- }
- If UBound(Var中心线与多段线交点) > 0 Then
, O$ ?$ ]2 ^% ]% p - '提取多段线顶点坐标
0 m' k& C N7 g3 s - Var多段线顶点 = Ent多段线.Coordinates7 u! i. c4 f2 t& j% `8 g
- '按多段线类型选择读取坐标的方式
3 P1 u$ D! K' X% a. c- ~ - If Ent多段线.ObjectName = "AcDb2dPolyline" Then
$ h9 u2 d* z& A) w8 X$ }, q1 ~( Q - Int循环步长 = 3# J. G1 i* G. y% F: J
- Else
9 G& ?% s" ]5 P! B - Int循环步长 = 2
# ]8 X% |- |& s) M# I% v& ]& u - End If9 \7 N) c; U k# \
- '从第一个顶点到倒数第二个顶点,逐点检查相邻顶点间线段的特性
: A1 Y1 F5 u; {) W - For Int循环变量 = 0 To UBound(Var多段线顶点) - Int循环步长 * 2 + 1 Step Int循环步长
+ F: n; a! Q: A( Q) T - '提取线段的起,端点
" h& X% Y3 P" c1 C9 {( k, L - Dbl线段起点(0) = Var多段线顶点(Int循环变量)5 O* [- k1 c: T
- Dbl线段起点(1) = Var多段线顶点(Int循环变量 + 1)
; S L/ i6 C9 y) `$ o" f - Dbl线段端点(0) = Var多段线顶点(Int循环变量 + Int循环步长)
, ?: A+ c6 t( u: ]+ [ - Dbl线段端点(1) = Var多段线顶点(Int循环变量 + Int循环步长 + 1)
: w9 e3 G7 }& | - '提取线段角度6 L; `# S* ?# F# n9 G" b# V% r
- Dbl线段角度 = ThisDrawing.Utility.AngleFromXAxis(Dbl线段起点, Dbl线段端点)
! [9 ~' r0 E: R/ n3 n% R6 R) p - '检查角度是否为"边坡",如果是则输出数据# w5 x' y) Q1 n& q6 m
- If Dbl线段角度 > 0.05 And Dbl线段角度 < ThisDrawing.Utility.AngleToReal(90, acDegrees) - 0.05 Or _; P- [) P% ], K
- Dbl线段角度 > ThisDrawing.Utility.AngleToReal(90, acDegrees) + 0.05 And _
: N3 }" O+ _( ? k; M3 L* ?( H; Y6 M+ ^ - Dbl线段角度 < ThisDrawing.Utility.AngleToReal(180, acDegrees) - 0.05 Or _0 R0 V% O V4 c: t( }7 u
- Dbl线段角度 > ThisDrawing.Utility.AngleToReal(180, acDegrees) + 0.05 And _
! W/ p) u* L/ D - Dbl线段角度 < ThisDrawing.Utility.AngleToReal(270, acDegrees) - 0.05 Or _- M. Q, N* p5 w4 h2 l; H, y
- Dbl线段角度 > ThisDrawing.Utility.AngleToReal(270, acDegrees) + 0.05 And _- r {( }) [3 z ]& f8 k
- Dbl线段角度 < ThisDrawing.Utility.AngleToReal(180, acDegrees) * 2 - 0.05 Then$ `( `4 _/ p: T% D0 f8 ]
- 'EXCEL工作表中行号递加
9 ^) L" h8 z+ n1 I+ r1 A& V) x$ D! J - Int行号 = Int行号 + 1$ r! T7 M" d. B
- '写入前面记录的桩号
6 k, @5 ^: N+ Z- Q - .Item(Int行号, 1) = Str桩号2 y1 Q- U& Q1 {4 D9 m1 \
- '判断该线段与中心线水平位置关系,并写入"左右"- L+ m. e* ]8 a1 m9 x' @
- If Dbl线段起点(0) < Var中心线下端点(0) Then* }+ P. Y& y1 d2 j9 D, X, ?. [
- .Item(Int行号, 2) = "左"
. m3 g* D7 x' ~" h! b - Else
) [: m% X. u2 P5 s - .Item(Int行号, 3) = "右"
( S. K) r' E% F0 [% U - End If3 y9 p6 ^+ d" }
- '写入边坡长度
( [8 F. k0 h3 }( C4 z - .Item(Int行号, 4) = Sqr((Dbl线段起点(0) - Dbl线段端点(0)) ^ 2 + (Dbl线段起点(1) - Dbl线段端点(1)) ^ 2)
' ~) q1 w" q, ?. X4 f8 l. p8 m" c - '写入坡率2 q* N& I/ `" ?2 c! E" W# G
- .Item(Int行号, 5) = Abs(1 / Tan(Dbl线段角度))8 z. q' |( c: x+ f" N( f3 O
- End If/ W) R S" Z7 |' E5 `
- Next
/ h# C- n7 {( h+ Y" o/ C - Exit For
) L5 J3 K: s, n: i( P - End If
* |( G# b4 H/ l" N4 t% @ - Next
4 C; f- P* X% u+ T9 m" @6 U1 i8 ] - Next& Q( V2 [! L& X$ C- w3 x6 V! I
- End With, Q& z$ [1 v2 Y+ V- s( g5 s: O9 K
- End With2 _5 i* i: \' x3 y/ u% O
- '删除用过的选择集5 c, \; C* j5 `0 Q- i5 H2 i2 z$ Q# h
- Ss中心线.Delete
3 o; h9 Y1 m! H - Ss文字.Delete, [- `7 k: `" n# F
- Ss多段线.Delete& ]1 v. E5 T, E0 `
- '保存EXCEL文档并退出
' B) F* u( _" U) z! X7 S - Excel文档.SaveAs Left(ThisDrawing.FullName, InStrRev(ThisDrawing.FullName, ".") - 1) & ".xls"( }. I% g- y# _" D9 U
- Excel进程.Quit
- O5 v/ n/ C# P* d& I$ ` - End Sub
8 j9 w) r Y8 C& e4 E* X& A
在使用此代码之前,务请在VBAIDE界面的"工具"菜单下打开"引用"对话框,正确设置对EXCEL类库的引用.
. p( u9 w( R7 R8 S0 M1 P五.附件是包含上面代码和对EXCEL的引用的dvb文件,由于本人PC中安装的是EXCEL2003程序,如果使用者的EXCEL版本与本人不同,请自行修改引用.( C3 x9 P; |# U& K# s" C
2 x$ X; H# y0 Z/ k* P+ g/ V# @- Z[ 本帖最后由 woaishuijia 于 2010-2-27 06:05 编辑 ] |
本帖子中包含更多资源
您需要 登录 才可以下载或查看，没有账号？立即注册
x
|
发表于 2010-2-17 02:23
楼主
哪位高手帮一下忙嘛……不然太累了
