|
|
首先声明,由于对楼主所在行业一窍不通,只能通过楼主在帖中提供的信息来推测符合楼主要求的规则和方法,错误和遗漏在所难免,还望谅解,以下内容仅做为意见和建议供楼主参考:
# s! r A* a9 ~0 k一.由于楼主要求用EXCEL输出,所以用LISP是不合适的,这是VBA的长项;! b% I5 B. K: i2 p* X9 b
二.楼主在"2.jpg"中提供的数据样例,疑似来自B1K46+360,而不是B1K46+350(详见附图)
1 r8 M; X2 s- f5 \! \/ V0 D5 j
% U2 {7 j% ^# \6 @7 y9 z: y2 b, S. t, W4 T; j' C
以下按此数据来自B1K46+360看待;9 x- O: s3 U* ^9 I; A
三.初步拟定规则和方法如下: S+ J8 {' T$ a. @- ? R+ C0 Y
假定:/ R7 o( ?9 t! v+ X
1.所有需要处理的图形和注释都在已打开的当前DWG文件的当前布局,且所有图形和注释都在WCS的XY平面上,都是二维的;
5 h d3 U7 m5 \; H# K: I 2.位于"zhix"图层的所有直线都是某个横断面唯一的"路面中心"线,且所有横断面都有一条"路面中心"线;+ R; S" q, m! ^9 W0 g; L& r
3.每一条"路面中心"线都对应存在一个或多个Y座标小于"路面中心"线下端点Y座标的,位于"shuju"图层的单行文字,其中与"路面中心"线下端点几何距离最近者是该断面的"桩号",按其全部文字内容输出"桩号"数据;
* H6 S- Q0 f' J% D 4.每一条"路面中心"线都有一条且仅有一条代表横截面的位于"sjx"图层的二维多段线与其相交;5 a3 j% y8 c/ m4 t0 \7 u
5.由于在图上测量得知"路面"部分最大斜度为1:0.03,所以,该多段线中角度为±0.05弧度,π/2±0.05弧度,π±0.05弧度和3π/2±0.05弧度的线段均不予理会,其它线段做为"边坡"看待,并按其与中心线的水平位置关系输出其"左右"数据,按其实测长度输出其"长度"数据,按其角度的余切值的绝对值输出"坡率"数据;' L7 \; V2 |, f; ^2 c$ d- G
6.输出的"xls"文件的路径和文件名,除扩展名外其它都与"dwg"文档相同
1 N4 _. M, Y) y X* W3 w# M四.按以下规则编写的VBA代码如下:
$ e+ n& o# {/ E3 q" k
& p& ?) j" N1 M' d- Sub HDM()8 h+ [$ n7 D9 a; m& p3 a! P8 D
- Dim Excel进程 As New Excel.Application, Excel文档 As Excel.WorkBook, Excel工作表 As Excel.Worksheet, Int行号 As Integer7 W. o g9 B% D: ]( ]; `0 ]
- Dim Ss中心线 As AcadSelectionSet, Ss多段线 As AcadSelectionSet, Ss文字 As AcadSelectionSet, Ft(1) As Integer, Fd(1) As Variant. P6 ]# _1 M+ d1 J- o/ Z$ z
- Dim Lin中心线 As AcadLine, Txt文字 As AcadText, Ent多段线 As AcadEntity
% q' f- { |- |/ w2 O3 m# P8 m) A$ F - Dim Var中心线下端点 As Variant, Dbl文字与中心线最小距离 As Double, Dbl文字与中心线距离 As Double, Str桩号 As String6 U/ O+ D4 u7 d6 n* z6 J: M
- Dim Var中心线与多段线交点 As Variant, Var多段线顶点 As Variant, Dbl线段起点(2) As Double, Dbl线段端点(2) As Double, Dbl线段角度 As Double# c& k7 N5 I8 o5 R
- Dim Int循环变量 As Integer, Int循环步长 As Integer
8 O8 M: z" S4 j2 _6 A - On Error Resume Next; N. _ O* `" O. _" V
- '创建三个选择集,分别选择中心线,横断面多段线和包含桩号的单行文字; P3 z2 @. z7 H
- With ThisDrawing.SelectionSets$ h9 X% V" f# d+ q" K; B) N
- Set Ss中心线 = .Add("中心线")
1 _+ F( g* C& z3 E" Z6 b: f - Set Ss文字 = .Add("文字")
& h. ^5 P! q, u) f& X' L& u - Set Ss多段线 = .Add("多段线")2 @* k6 m( O) F* o2 Y) k2 @
- End With
4 a% e' Y- P# H' v1 S# g - Ft(0) = 05 F& U, I4 B" u9 v* [# y
- Fd(0) = "LINE"' F+ q9 e1 Z, b2 v" N* h
- Ft(1) = 8
" Q; u8 a+ @6 ~6 q. P0 _5 c - Fd(1) = "zhix"( h. v9 @1 m2 U0 P- i1 R) @- K: ?
- Ss中心线.Select acSelectionSetAll, , , Ft, Fd: Q2 }( f" M5 q- p
- Fd(0) = "TEXT"
2 D7 V3 Z+ u3 m( q- g& u* h - Fd(1) = "shuju". _% M4 D" @- p* u
- Ss文字.Select acSelectionSetAll, , , Ft, Fd4 O# E2 P$ G, J6 q' n+ L5 j
- Fd(0) = "POLYLINE,LWPOLYLINE"9 i% G- z5 {: o8 h5 y. w7 d" @
- Fd(1) = "sjx": J: [6 { {1 z; \ L, d/ W
- Ss多段线.Select acSelectionSetAll, , , Ft, Fd% ~5 c' q5 y# {/ e8 f: f
- '创建新EXCEL文档( E2 W; m# e' C& n* S$ W5 ~
- Set Excel文档 = Excel进程.Workbooks.Add' v3 D( W q* c
- Set Excel工作表 = Excel文档.ActiveSheet
/ _' J% E% R, e8 H n - With Excel工作表) K. E0 p0 ~% u6 `
- '修改工作表名称,并在第一行写入表头文字
/ r' d0 m% U5 r5 ?9 Y+ ^% A - .Name = "横断面数据"
6 S: Y! W7 P5 z# a - .Cells.Item(1, 1) = "桩号"
; g2 x- y, w' \6 ?# B - .Cells.Item(1, 2) = "位置"0 Q, S+ H5 _( ^9 l. W0 h* y$ Q
- '合并单元格
; `- S" z; X3 J. U9 }0 Q/ g - .Range("B1:C1").Merge
/ z" s0 J, o# Y& j5 E% B3 x - .Cells.Item(1, 4) = "长度"; V' Z+ `+ u+ s+ o8 ?
- .Cells.Item(1, 5) = "坡率"
6 q+ @5 r4 P- m( w; G - '设置单元格对齐方式为水平中心对齐
. F7 b% |$ N# [! z0 ]1 R - .Columns("A:E").HorizontalAlignment = xlCenter
: B0 D) s3 L, ]7 J' U - Int行号 = 13 K3 S# e3 B8 K' Y9 v4 _
- With .Cells4 h7 \+ J' P/ s8 M1 [% w" u# E
- '遍历中心线( s# C2 T% k& A( F0 L; r6 J5 t3 N9 U
- For Each Lin中心线 In Ss中心线
0 g$ m' A4 Q+ E( H9 ?+ N - '提取中心线下端点6 F- O' N0 _0 v" a2 a# N6 z
- If Lin中心线.StartPoint(1) > Lin中心线.EndPoint(1) Then
# T0 T3 X1 {, W. N/ a8 {9 \ - Var中心线下端点 = Lin中心线.EndPoint
! U2 y" D! p6 u0 l - Else
( M' O& S* h' | - Var中心线下端点 = Lin中心线.StartPoint
( ~4 \/ v6 k3 ~% r - End If2 y, w$ I4 x# K% u# B0 u* p! ]$ g0 i
- '遍历单行文字,找出与中心线对应的桩号并记录
4 ~9 j% |% S( ?0 Y/ r# z- Y8 w - Dbl文字与中心线最小距离 = 09 r& G( q" G9 l
- For Each Txt文字 In Ss文字) e c! f1 i7 d3 g
- If Txt文字.InsertionPoint(1) < Var中心线下端点(1) Then+ c6 ?9 y" Z6 _* B
- Dbl文字与中心线距离 = Sqr((Var中心线下端点(0) - Txt文字.InsertionPoint(0)) ^ 2 + (Var中心线下端点(1) - Txt文字.InsertionPoint(1)) ^ 2)6 o7 _8 `6 i9 u# D, C- ^
- If Dbl文字与中心线最小距离 = 0 Or Dbl文字与中心线距离 < Dbl文字与中心线最小距离 Then5 \8 M; I$ [9 D, V; ?4 o) l
- Dbl文字与中心线最小距离 = Dbl文字与中心线距离/ N+ I% e$ R: N X4 m6 C' q
- Str桩号 = Txt文字.TextString2 {) h% m6 \, J3 A0 j: s6 V# f
- End If* }+ E% j: ^7 i2 C! @
- End If: j6 j& c/ \; p7 `7 ?, H- e* V
- Next6 J' V9 B6 J4 G$ v+ {' J* z1 G
- '遍历横断面多段线
r1 G% Q8 ^" S& k - For Each Ent多段线 In Ss多段线9 w) l' k; e; D8 X( c6 Z8 @
- '检查多段线与中心线是否存在交点,如存在交点则输出数据+ Z3 |: M' k G8 {9 t- [
- Var中心线与多段线交点 = Lin中心线.IntersectWith(Ent多段线, acExtendNone)
. j, [$ k' D2 L6 ] - If UBound(Var中心线与多段线交点) > 0 Then& F+ p+ _0 ^+ D1 r
- '提取多段线顶点坐标
* f) {( @) r* ? - Var多段线顶点 = Ent多段线.Coordinates
3 y. b; L9 w, ^ - '按多段线类型选择读取坐标的方式
, |' {" ]/ C: X# I9 a, o - If Ent多段线.ObjectName = "AcDb2dPolyline" Then" X7 {9 C7 A. T( {# C
- Int循环步长 = 3. i* z* v t8 g* x5 J
- Else8 O/ q# D* H1 I) v1 j+ x( a
- Int循环步长 = 2
( D3 I5 i/ F+ ]) }& d - End If
3 ?, ~. \7 {5 \# ` - '从第一个顶点到倒数第二个顶点,逐点检查相邻顶点间线段的特性
8 A6 G7 u4 r5 w! U e - For Int循环变量 = 0 To UBound(Var多段线顶点) - Int循环步长 * 2 + 1 Step Int循环步长
+ ^5 H" F# i7 S5 Y* T - '提取线段的起,端点6 ?" A& T' v5 k4 f* W9 O% G
- Dbl线段起点(0) = Var多段线顶点(Int循环变量)- R8 u8 A$ v2 ~( F( W
- Dbl线段起点(1) = Var多段线顶点(Int循环变量 + 1)/ |& V6 M6 e& f1 n- |) z9 E
- Dbl线段端点(0) = Var多段线顶点(Int循环变量 + Int循环步长)
- b8 E: a$ ?5 ~. \5 F - Dbl线段端点(1) = Var多段线顶点(Int循环变量 + Int循环步长 + 1)8 N4 P, K' s$ N$ t4 N% `0 m
- '提取线段角度
* C# y' p: N: O - Dbl线段角度 = ThisDrawing.Utility.AngleFromXAxis(Dbl线段起点, Dbl线段端点)
+ l1 c* J$ ]. T$ h5 y% C+ [ j - '检查角度是否为"边坡",如果是则输出数据% }9 e' j) O4 ]4 y" U b! z
- If Dbl线段角度 > 0.05 And Dbl线段角度 < ThisDrawing.Utility.AngleToReal(90, acDegrees) - 0.05 Or _
% k; X5 N% i, \. U& k9 \( g - Dbl线段角度 > ThisDrawing.Utility.AngleToReal(90, acDegrees) + 0.05 And _
+ E0 N( E- O6 ] - Dbl线段角度 < ThisDrawing.Utility.AngleToReal(180, acDegrees) - 0.05 Or _
: @, H B' O' {$ R$ o$ y8 k5 m - Dbl线段角度 > ThisDrawing.Utility.AngleToReal(180, acDegrees) + 0.05 And _
8 U& R# e& N% V2 o/ R$ I5 [ - Dbl线段角度 < ThisDrawing.Utility.AngleToReal(270, acDegrees) - 0.05 Or _
! f' [+ y; {( A/ } c7 P - Dbl线段角度 > ThisDrawing.Utility.AngleToReal(270, acDegrees) + 0.05 And _: V7 P1 b' K, r! h$ ~3 q& l4 M9 Q
- Dbl线段角度 < ThisDrawing.Utility.AngleToReal(180, acDegrees) * 2 - 0.05 Then, _; a) r7 i, r, k
- 'EXCEL工作表中行号递加4 r. d# n8 }; N' F4 O4 T- u
- Int行号 = Int行号 + 17 j, U$ p3 Z( `! n2 H+ @. }% ~ D
- '写入前面记录的桩号
. Q: n, k+ y% E$ E7 O; T4 T1 D - .Item(Int行号, 1) = Str桩号- F3 U7 ]6 l! R& y" t
- '判断该线段与中心线水平位置关系,并写入"左右"
. }/ e! g* w! ?2 |/ B$ [% [ - If Dbl线段起点(0) < Var中心线下端点(0) Then" V7 S" L. r5 z& E% E
- .Item(Int行号, 2) = "左"6 P( \6 Y( T) e y E
- Else8 x) m( h" i* |% }4 R
- .Item(Int行号, 3) = "右"
9 A/ r/ [+ h& i; E T - End If6 E* j: i% ^( H! \7 e* L" y; T4 a
- '写入边坡长度! a7 B: U. J0 \# V% O0 D3 _
- .Item(Int行号, 4) = Sqr((Dbl线段起点(0) - Dbl线段端点(0)) ^ 2 + (Dbl线段起点(1) - Dbl线段端点(1)) ^ 2)9 I' Y: c! ]; F: Z$ s
- '写入坡率
, E) u8 G0 P) w" k - .Item(Int行号, 5) = Abs(1 / Tan(Dbl线段角度))
6 K: U" g! I- y - End If, V1 S. L0 a" h& R6 A& N
- Next
4 I7 _9 s3 g0 R8 y3 t - Exit For5 b8 }6 L% ]9 V% t9 E( B7 }
- End If1 J _) Z% G2 ?9 ~9 H+ {
- Next
3 y, `. s% N& Q; B4 U u# `! a$ ` - Next
$ ~: |1 Z; K& y# a, m7 ?* H) @ - End With
: u: J& r! A ^+ z4 o% {& E$ \# i h- m3 r - End With5 `& K( S: ?) E. }! U$ T9 H
- '删除用过的选择集
+ C. k* N9 _: U4 Y/ q u - Ss中心线.Delete
$ d8 C, o; y$ a% x - Ss文字.Delete
; d0 ?9 q8 R: ]* o5 m6 B6 Y, `' m - Ss多段线.Delete
7 z) G- O1 Q3 ~9 Y) T: u3 Z - '保存EXCEL文档并退出* O1 z/ r% z2 ]: f
- Excel文档.SaveAs Left(ThisDrawing.FullName, InStrRev(ThisDrawing.FullName, ".") - 1) & ".xls"
( W+ J: k5 Z6 Y' Z! W) I* ?3 W- ` - Excel进程.Quit
* G: e; c% I* \* _ - End Sub" n4 l% o: }6 d" ]' G
在使用此代码之前,务请在VBAIDE界面的"工具"菜单下打开"引用"对话框,正确设置对EXCEL类库的引用.5 B0 g+ q) j8 o: b* R
五.附件是包含上面代码和对EXCEL的引用的dvb文件,由于本人PC中安装的是EXCEL2003程序,如果使用者的EXCEL版本与本人不同,请自行修改引用.; N+ b+ y8 ?4 ^
7 J* r" O) o$ T: e: L" I
[ 本帖最后由 woaishuijia 于 2010-2-27 06:05 编辑 ] |
本帖子中包含更多资源
您需要 登录 才可以下载或查看，没有账号？立即注册
x
|
发表于 2010-2-17 02:23
楼主
哪位高手帮一下忙嘛……不然太累了
