|
|
首先声明,由于对楼主所在行业一窍不通,只能通过楼主在帖中提供的信息来推测符合楼主要求的规则和方法,错误和遗漏在所难免,还望谅解,以下内容仅做为意见和建议供楼主参考:
1 Z) s& |- N( `4 @% B一.由于楼主要求用EXCEL输出,所以用LISP是不合适的,这是VBA的长项;
9 D3 k8 D' @, \1 }二.楼主在"2.jpg"中提供的数据样例,疑似来自B1K46+360,而不是B1K46+350(详见附图) p( t. K6 Q" n: }2 \
/ m% D8 {4 y+ Q0 @ l: [. m( w
/ f0 P! r: K) H- D, g" k9 B. r 以下按此数据来自B1K46+360看待;
. u7 a3 H$ B1 |; B三.初步拟定规则和方法如下:
. V1 `5 R5 X/ M. @: j 假定:( m* _( g. J; [4 t
1.所有需要处理的图形和注释都在已打开的当前DWG文件的当前布局,且所有图形和注释都在WCS的XY平面上,都是二维的;7 G5 u! z, F8 n7 Z$ ^5 {* a
2.位于"zhix"图层的所有直线都是某个横断面唯一的"路面中心"线,且所有横断面都有一条"路面中心"线;2 {1 o5 M- X% {0 v
3.每一条"路面中心"线都对应存在一个或多个Y座标小于"路面中心"线下端点Y座标的,位于"shuju"图层的单行文字,其中与"路面中心"线下端点几何距离最近者是该断面的"桩号",按其全部文字内容输出"桩号"数据;
/ r) j8 x7 A! E$ d; @2 n 4.每一条"路面中心"线都有一条且仅有一条代表横截面的位于"sjx"图层的二维多段线与其相交;- O7 @" Q7 e; G. ?! E
5.由于在图上测量得知"路面"部分最大斜度为1:0.03,所以,该多段线中角度为±0.05弧度,π/2±0.05弧度,π±0.05弧度和3π/2±0.05弧度的线段均不予理会,其它线段做为"边坡"看待,并按其与中心线的水平位置关系输出其"左右"数据,按其实测长度输出其"长度"数据,按其角度的余切值的绝对值输出"坡率"数据;
! k9 \# p) n1 E- q+ N4 O 6.输出的"xls"文件的路径和文件名,除扩展名外其它都与"dwg"文档相同. {# |4 ?; Y2 l) a
四.按以下规则编写的VBA代码如下:
! B9 C" Y9 }; A8 H* j
& U7 @2 q: O7 o9 f! s3 F. p- Sub HDM()- v5 F' X2 q8 y6 y( u& i! r
- Dim Excel进程 As New Excel.Application, Excel文档 As Excel.WorkBook, Excel工作表 As Excel.Worksheet, Int行号 As Integer* }0 j2 T+ r7 a+ o7 |+ z
- Dim Ss中心线 As AcadSelectionSet, Ss多段线 As AcadSelectionSet, Ss文字 As AcadSelectionSet, Ft(1) As Integer, Fd(1) As Variant
+ L/ s2 _% u5 \1 d- `& M - Dim Lin中心线 As AcadLine, Txt文字 As AcadText, Ent多段线 As AcadEntity0 \5 ?/ a" s* g; }0 S
- Dim Var中心线下端点 As Variant, Dbl文字与中心线最小距离 As Double, Dbl文字与中心线距离 As Double, Str桩号 As String/ H$ e$ p+ D& v( t
- Dim Var中心线与多段线交点 As Variant, Var多段线顶点 As Variant, Dbl线段起点(2) As Double, Dbl线段端点(2) As Double, Dbl线段角度 As Double
, k! E+ w" i1 ]& u0 p9 r - Dim Int循环变量 As Integer, Int循环步长 As Integer3 s4 k% N2 l* d) @
- On Error Resume Next
, J6 F* H5 i4 `. X/ J - '创建三个选择集,分别选择中心线,横断面多段线和包含桩号的单行文字
* g% V& G' F/ w3 {& y4 f+ w9 l - With ThisDrawing.SelectionSets
/ @& N+ [1 w( s' N - Set Ss中心线 = .Add("中心线")
' i$ B/ z2 F3 K# t- V - Set Ss文字 = .Add("文字")
1 U2 L2 A7 g, j9 [ - Set Ss多段线 = .Add("多段线")
# e" Z" B# P" f- t ~; i - End With2 j5 H! T9 q" R2 X* w' o0 @4 V
- Ft(0) = 0! j. i2 n$ u5 M: e/ E
- Fd(0) = "LINE"
& S5 Z* s- j) }0 D$ ^( ? - Ft(1) = 8
9 p; V( q7 e! ~ - Fd(1) = "zhix"- H* J+ S; P: e1 d/ _9 @
- Ss中心线.Select acSelectionSetAll, , , Ft, Fd
' ^% N. L$ |% D( o; i' [ - Fd(0) = "TEXT"8 V$ L; o2 Y2 _
- Fd(1) = "shuju"
6 |$ q! H0 A! {" G2 w - Ss文字.Select acSelectionSetAll, , , Ft, Fd
5 N- K% ?4 K6 y1 k7 z: X - Fd(0) = "POLYLINE,LWPOLYLINE"$ D7 w# n0 E! ]8 V& H6 X% J. R
- Fd(1) = "sjx"
. X4 H( M8 E0 J- R* s/ a, g' _ - Ss多段线.Select acSelectionSetAll, , , Ft, Fd) A6 G. g2 V* Z3 y' N
- '创建新EXCEL文档& K. r6 h, P3 ?0 T8 ]$ h- M! N4 S
- Set Excel文档 = Excel进程.Workbooks.Add
0 {( `& i6 f' a1 Z" \5 e+ p - Set Excel工作表 = Excel文档.ActiveSheet% Q1 W+ t2 y% n" P; I1 |: b: A
- With Excel工作表1 C& Y% m% L: T9 k
- '修改工作表名称,并在第一行写入表头文字
' \3 w) N5 s1 A$ \' [% ^8 ]$ @ - .Name = "横断面数据". W" P+ i3 |; [* S, b" Q4 i
- .Cells.Item(1, 1) = "桩号"
3 t( `5 l; _, _6 I - .Cells.Item(1, 2) = "位置"4 k" ?, e1 @; N0 O. L: r
- '合并单元格
6 J' A3 n% o" K+ Q - .Range("B1:C1").Merge
3 c5 X) W, {# s5 K2 v7 J) t" `: l - .Cells.Item(1, 4) = "长度"
# M7 w# x4 a: E, R; {, v& ` - .Cells.Item(1, 5) = "坡率"
8 \5 \9 `% O6 C2 D - '设置单元格对齐方式为水平中心对齐
' T, ^( ~3 v' B. p+ Y1 h - .Columns("A:E").HorizontalAlignment = xlCenter
. o' W$ i, s5 d0 y) ` - Int行号 = 1- x6 u& f7 F1 ?- _3 Y
- With .Cells- x- L. [: I: G3 X! S
- '遍历中心线
: R, z: i* |, P2 }9 D; O* ~ - For Each Lin中心线 In Ss中心线) |: H( g6 U) q$ d9 m' J/ p
- '提取中心线下端点- J) A$ j4 L( F% b9 H i' H
- If Lin中心线.StartPoint(1) > Lin中心线.EndPoint(1) Then
! p! z# x& N2 E' w2 D) A! O" J o; u - Var中心线下端点 = Lin中心线.EndPoint
/ V5 v4 P9 V9 {/ X - Else
; \% Q+ i$ C% x) F3 U& H/ T - Var中心线下端点 = Lin中心线.StartPoint
5 T- U N' N6 M2 z* L0 [ - End If! o+ l4 k) g n: T' s! h
- '遍历单行文字,找出与中心线对应的桩号并记录( D2 [- b9 g8 z4 V! T3 s* q
- Dbl文字与中心线最小距离 = 0
+ m+ G0 h& V8 [2 d - For Each Txt文字 In Ss文字. M) H$ a* N2 O* L+ J! l
- If Txt文字.InsertionPoint(1) < Var中心线下端点(1) Then/ q+ k7 \) ?! u8 H
- Dbl文字与中心线距离 = Sqr((Var中心线下端点(0) - Txt文字.InsertionPoint(0)) ^ 2 + (Var中心线下端点(1) - Txt文字.InsertionPoint(1)) ^ 2)" H5 }! B1 ^1 [7 _! q6 w
- If Dbl文字与中心线最小距离 = 0 Or Dbl文字与中心线距离 < Dbl文字与中心线最小距离 Then1 ?! n3 U1 j" S
- Dbl文字与中心线最小距离 = Dbl文字与中心线距离
+ d: `6 n7 h j: x4 h - Str桩号 = Txt文字.TextString
0 @- p- u! t$ x' r8 X - End If" f% ?7 s# Z1 K s9 P9 A
- End If
+ f; W1 q3 }- i( ^ - Next! R) ?. x8 Z* F4 _
- '遍历横断面多段线3 U+ z/ B- l- S0 N- `6 E
- For Each Ent多段线 In Ss多段线
5 t; f2 s& }. R7 [9 G* j7 l0 P3 V - '检查多段线与中心线是否存在交点,如存在交点则输出数据6 t) ]/ }* t* E
- Var中心线与多段线交点 = Lin中心线.IntersectWith(Ent多段线, acExtendNone); Q% b3 \" j+ O& b: l
- If UBound(Var中心线与多段线交点) > 0 Then
% a7 E5 H9 n( @9 B" r - '提取多段线顶点坐标; g! q9 Q9 x6 `2 L* k) ?9 n
- Var多段线顶点 = Ent多段线.Coordinates
) R! N( Y1 ?) M3 \+ K- [! W% u' y - '按多段线类型选择读取坐标的方式
7 i0 v w8 w; A! {. [9 B - If Ent多段线.ObjectName = "AcDb2dPolyline" Then( A6 S- ^1 v. q% Z$ z" R9 T
- Int循环步长 = 3
; O2 I% K S, U, f' H - Else
0 B; b7 O% y" ] - Int循环步长 = 2$ ]6 i) q3 \+ c7 Y* a A
- End If
1 `5 K) p4 n" z s* q - '从第一个顶点到倒数第二个顶点,逐点检查相邻顶点间线段的特性, f1 k E: r' [: V
- For Int循环变量 = 0 To UBound(Var多段线顶点) - Int循环步长 * 2 + 1 Step Int循环步长
( d8 W1 | Z9 w! e3 W - '提取线段的起,端点
$ o, V% Y- Q0 q' k5 a - Dbl线段起点(0) = Var多段线顶点(Int循环变量)1 w0 J; f9 Q- F$ t5 F
- Dbl线段起点(1) = Var多段线顶点(Int循环变量 + 1)
# N2 y3 H. p) U+ s6 \5 ?! e - Dbl线段端点(0) = Var多段线顶点(Int循环变量 + Int循环步长)
6 j' ^- q& q. | - Dbl线段端点(1) = Var多段线顶点(Int循环变量 + Int循环步长 + 1)
8 ? b( Z7 j) H- S% X - '提取线段角度% e& _/ b; J) [7 Z" |
- Dbl线段角度 = ThisDrawing.Utility.AngleFromXAxis(Dbl线段起点, Dbl线段端点)
* O" n7 K) J) N! n2 g5 ?% I - '检查角度是否为"边坡",如果是则输出数据7 t4 l; @5 Q l. P3 e
- If Dbl线段角度 > 0.05 And Dbl线段角度 < ThisDrawing.Utility.AngleToReal(90, acDegrees) - 0.05 Or _* K, X0 o1 T/ o* r+ e
- Dbl线段角度 > ThisDrawing.Utility.AngleToReal(90, acDegrees) + 0.05 And _" X) _* _9 u' w+ _5 G
- Dbl线段角度 < ThisDrawing.Utility.AngleToReal(180, acDegrees) - 0.05 Or _
; p% [4 }* F; ^5 W i - Dbl线段角度 > ThisDrawing.Utility.AngleToReal(180, acDegrees) + 0.05 And _6 M& @$ s5 m) Y0 P
- Dbl线段角度 < ThisDrawing.Utility.AngleToReal(270, acDegrees) - 0.05 Or _) r$ _ [2 ] e2 j# b- v6 a
- Dbl线段角度 > ThisDrawing.Utility.AngleToReal(270, acDegrees) + 0.05 And _6 ~( Q& ]8 a6 q5 I: [: |6 S
- Dbl线段角度 < ThisDrawing.Utility.AngleToReal(180, acDegrees) * 2 - 0.05 Then! v4 I; Z5 g5 s5 r8 c
- 'EXCEL工作表中行号递加, G/ M* e; m- g0 s
- Int行号 = Int行号 + 1
' k5 O. d+ I; N4 Z( f - '写入前面记录的桩号
0 I" x5 Z# I$ |/ ^ - .Item(Int行号, 1) = Str桩号1 r4 X4 T% L( N+ S; ~# p# ^0 `
- '判断该线段与中心线水平位置关系,并写入"左右"
0 I6 }, J" w- {) U% r - If Dbl线段起点(0) < Var中心线下端点(0) Then9 Z) l$ O/ t/ w2 L" L1 r
- .Item(Int行号, 2) = "左"
/ A7 b# p1 m" ?" Q4 J' f9 ~! n - Else
! @& O+ N7 P- l T/ ?3 ~$ b! u3 O8 I - .Item(Int行号, 3) = "右"0 y( [7 P; r" t- P$ V q
- End If
7 }: L4 B) W% X) l# g/ I8 C+ C' f$ j - '写入边坡长度$ l% z2 F. c6 z* w {; r
- .Item(Int行号, 4) = Sqr((Dbl线段起点(0) - Dbl线段端点(0)) ^ 2 + (Dbl线段起点(1) - Dbl线段端点(1)) ^ 2), l3 R' u% N6 z/ X; X+ i* s4 d
- '写入坡率
# ?; M3 J2 ]+ U N - .Item(Int行号, 5) = Abs(1 / Tan(Dbl线段角度))
5 H4 X! F' j3 ?: i5 Z - End If
6 R& Q7 i0 u8 h" {( F, D - Next% k/ m* Q+ s2 i) s& `7 L* l
- Exit For3 A/ Q" A: ~& e& h. o% w
- End If) w6 v/ W4 i- _( h( n: x
- Next
4 ]5 H3 Y" N0 ~ - Next
& @4 E) Y/ _/ u+ B - End With% T d$ D& e) C6 `/ i, N/ ?
- End With/ `3 a- s5 o1 H/ k6 l) {9 V) E" K$ H
- '删除用过的选择集
" Z: y0 T/ t8 }* [ - Ss中心线.Delete I+ }4 x: z! K0 s. A$ o
- Ss文字.Delete7 Z( I1 `4 p4 P9 a, Z
- Ss多段线.Delete
: i9 g* p9 N g3 ?7 l# R7 h0 k - '保存EXCEL文档并退出; _6 _8 s% f A- j0 F; q
- Excel文档.SaveAs Left(ThisDrawing.FullName, InStrRev(ThisDrawing.FullName, ".") - 1) & ".xls"; g# o/ a4 o! g" \, V3 H
- Excel进程.Quit
8 j) w) ^2 {" S: z! m - End Sub
9 b% X+ w3 S# ^
7 m* M6 e# |! L K/ y/ U! W/ a# L% { 在使用此代码之前,务请在VBAIDE界面的"工具"菜单下打开"引用"对话框,正确设置对EXCEL类库的引用.% J @+ a: U- D# c0 n
五.附件是包含上面代码和对EXCEL的引用的dvb文件,由于本人PC中安装的是EXCEL2003程序,如果使用者的EXCEL版本与本人不同,请自行修改引用.
* ?' {% `) V: ]9 |% C/ o8 i( m; y9 ^
[ 本帖最后由 woaishuijia 于 2010-2-27 06:05 编辑 ] |
本帖子中包含更多资源
您需要 登录 才可以下载或查看，没有账号？立即注册
x
|
发表于 2010-2-17 02:23
楼主
哪位高手帮一下忙嘛……不然太累了
