史上最全的lsp程序分享

小书僮

哈哈，问题已经解决，看来这里有高手哦^_^
5 M' o9 S: U/ U7 P1 Y1 W
: L$ U& }: l$ h/ ][ 本帖最后由 小书僮 于 2010-2-27 01:48 编辑 ]

Camello

只看懂了 B1K46+380 序列
' k, b) W" I( J. K9 R其余未知从何而得

小书僮

没懂……我的思路是：1.关闭除横断面以外的其他图层（即只显示横断面红线的长度，注释、原坡面线隐藏）2.编一个LSP程序，全选所有断面后，可以批量测量长度。3.打开桩号、坡率所在图层，用一个程序，把所有横断面的桩号、左右、长度、及坡率批量输入excel。但是编程太难了，我参考了网上许多lsp程序，一头雾水
- U8 O4 l4 o2 B: B5 R- r
[ 本帖最后由 小书僮 于 2010-2-18 12:23 编辑 ]

小书僮

哪位高手帮一下忙嘛……不然太累了

癫者TT

我看都没看懂

jiangch9726

怎么这里有那么多的好东西啊，真的要多来看看

hulij

怎么这里有那么多的好东西啊，真的要多来看看

woaishuijia

首先声明,由于对楼主所在行业一窍不通,只能通过楼主在帖中提供的信息来推测符合楼主要求的规则和方法,错误和遗漏在所难免,还望谅解,以下内容仅做为意见和建议供楼主参考:
$ w' I* H0 ?- f2 G/ G8 n一.由于楼主要求用EXCEL输出,所以用LISP是不合适的,这是VBA的长项;
二.楼主在"2.jpg"中提供的数据样例,疑似来自B1K46+360,而不是B1K46+350(详见附图)
2 J) M7 w. ?) J% H
5 D5 \' s# L" r5 v2 [& s' B# m
5 w+ l) z- T$ p3 c    以下按此数据来自B1K46+360看待;
' @$ R- S6 U6 Y三.初步拟定规则和方法如下:
    假定:
/ w( }; M" J) `; h6 I, p    1.所有需要处理的图形和注释都在已打开的当前DWG文件的当前布局,且所有图形和注释都在WCS的XY平面上,都是二维的;
    2.位于"zhix"图层的所有直线都是某个横断面唯一的"路面中心"线,且所有横断面都有一条"路面中心"线;
# ^# J2 V$ \. L8 U! Z8 _9 R$ I9 M    3.每一条"路面中心"线都对应存在一个或多个Y座标小于"路面中心"线下端点Y座标的,位于"shuju"图层的单行文字,其中与"路面中心"线下端点几何距离最近者是该断面的"桩号",按其全部文字内容输出"桩号"数据;
    4.每一条"路面中心"线都有一条且仅有一条代表横截面的位于"sjx"图层的二维多段线与其相交;
8 E+ v; M6 b  m8 D" E7 Y& f, C2 e    5.由于在图上测量得知"路面"部分最大斜度为1:0.03,所以,该多段线中角度为±0.05弧度,π/2±0.05弧度,π±0.05弧度和3π/2±0.05弧度的线段均不予理会,其它线段做为"边坡"看待,并按其与中心线的水平位置关系输出其"左右"数据,按其实测长度输出其"长度"数据,按其角度的余切值的绝对值输出"坡率"数据;
    6.输出的"xls"文件的路径和文件名,除扩展名外其它都与"dwg"文档相同
+ l# a4 @* Y0 ~4 W$ r0 e. p5 u4 d& s四.按以下规则编写的VBA代码如下:
4 ^8 ~. d# w# P+ M/ D! O

1. 
   
2. Sub HDM()
   
3.     Dim Excel进程 As New Excel.Application, Excel文档 As Excel.WorkBook, Excel工作表 As Excel.Worksheet, Int行号 As Integer
   * v( A- _5 m& J- D2 B
4.     Dim Ss中心线 As AcadSelectionSet, Ss多段线 As AcadSelectionSet, Ss文字 As AcadSelectionSet, Ft(1) As Integer, Fd(1) As Variant
   % `, I/ B) U; n3 I
5.     Dim Lin中心线 As AcadLine, Txt文字 As AcadText, Ent多段线 As AcadEntity
   
6.     Dim Var中心线下端点 As Variant, Dbl文字与中心线最小距离 As Double, Dbl文字与中心线距离 As Double, Str桩号 As String
   7 G( R% x. K! t4 U$ G9 G) b; N
7.     Dim Var中心线与多段线交点 As Variant, Var多段线顶点 As Variant, Dbl线段起点(2) As Double, Dbl线段端点(2) As Double, Dbl线段角度 As Double
   
8.     Dim Int循环变量 As Integer, Int循环步长 As Integer
   
9.     On Error Resume Next
   4 k- K& D7 b2 a! s2 ~5 p
10.     '创建三个选择集,分别选择中心线,横断面多段线和包含桩号的单行文字
    ( t9 V; G1 ?' @& T: Q# O. c6 h
11.     With ThisDrawing.SelectionSets
    2 f; S! H7 i& ?& G3 d# T; `+ g) u
12.         Set Ss中心线 = .Add("中心线")
    
13.         Set Ss文字 = .Add("文字")
    
14.         Set Ss多段线 = .Add("多段线")
    / J0 G9 Y# A5 }- b$ X- u' w  [
15.     End With
    ) G' f* X% ~. K2 p6 v
16.     Ft(0) = 0
    
17.     Fd(0) = "LINE"
    , p, M: t: R  Z2 C
18.     Ft(1) = 8
    
19.     Fd(1) = "zhix"
    3 ^) p  E* d$ ]6 ~: J- V, q
20.     Ss中心线.Select acSelectionSetAll, , , Ft, Fd
    
21.     Fd(0) = "TEXT"
    
22.     Fd(1) = "shuju"
    7 x6 k- F" ]  Q9 ?* o0 ^. l
23.     Ss文字.Select acSelectionSetAll, , , Ft, Fd
    ( G; `' H" g# ]& a- }( K
24.     Fd(0) = "POLYLINE,LWPOLYLINE"
    
25.     Fd(1) = "sjx"
    
26.     Ss多段线.Select acSelectionSetAll, , , Ft, Fd
    3 g# [, N, ?; N1 d3 U- G0 q; G/ ]* n' Z
27.     '创建新EXCEL文档
    ' V; [7 g% j8 V: w( X
28.     Set Excel文档 = Excel进程.Workbooks.Add
    - N+ I# L# ]3 g2 A+ T! z) J  ^
29.     Set Excel工作表 = Excel文档.ActiveSheet
    * ]5 [& C4 n+ J# H$ o% K- k
30.     With Excel工作表
    7 c( d7 S) m+ \6 C
31.         '修改工作表名称,并在第一行写入表头文字
    / o$ }3 Q7 ?6 _! x0 Q, R
32.         .Name = "横断面数据"
    
33.         .Cells.Item(1, 1) = "桩号"
    ' R- \" F. A, ^' O! E, [, c8 T
34.         .Cells.Item(1, 2) = "位置"
    - q  E, V# K: `% \$ A& b
35.         '合并单元格
    4 ^/ i: \2 u3 O# m
36.         .Range("B1:C1").Merge
    
37.         .Cells.Item(1, 4) = "长度"
    5 E0 Q; z, h1 ~9 ?  {; P( [
38.         .Cells.Item(1, 5) = "坡率"
    
39.         '设置单元格对齐方式为水平中心对齐
    
40.         .Columns("A:E").HorizontalAlignment = xlCenter
    
41.         Int行号 = 1
    0 j$ U) `( K0 o& G. n
42.         With .Cells
    
43.             '遍历中心线
    # q: X7 v$ E  G5 B( ]
44.             For Each Lin中心线 In Ss中心线
    
45.                 '提取中心线下端点
    ( F" u, L8 k% _5 |/ o* c
46.                 If Lin中心线.StartPoint(1) > Lin中心线.EndPoint(1) Then
    0 A& N3 q6 e. k( d9 W
47.                     Var中心线下端点 = Lin中心线.EndPoint
    " B- G  `- V/ I4 H, u' w
48.                 Else
    ' j; X+ j: M& {, G, f
49.                     Var中心线下端点 = Lin中心线.StartPoint
    
50.                 End If
    ! Z/ @3 `$ N- p6 Z
51.                 '遍历单行文字,找出与中心线对应的桩号并记录
    
52.                 Dbl文字与中心线最小距离 = 0
    
53.                 For Each Txt文字 In Ss文字
    9 W' g4 t% A+ R- q
54.                     If Txt文字.InsertionPoint(1) < Var中心线下端点(1) Then
    1 B' |0 ?! m7 Y! e! p6 ?( M
55.                         Dbl文字与中心线距离 = Sqr((Var中心线下端点(0) - Txt文字.InsertionPoint(0)) ^ 2 + (Var中心线下端点(1) - Txt文字.InsertionPoint(1)) ^ 2)
    
56.                         If Dbl文字与中心线最小距离 = 0 Or Dbl文字与中心线距离 < Dbl文字与中心线最小距离 Then
    : Y; z% W, A0 s8 ~' q
57.                             Dbl文字与中心线最小距离 = Dbl文字与中心线距离
    4 s. t8 {  x; f6 s  h! K
58.                             Str桩号 = Txt文字.TextString
    ) [8 u7 \- ?! z- x9 R, U/ b
59.                         End If
    6 x$ n' L: R; x& B% Z; t3 j7 V
60.                     End If
    
61.                 Next
    8 G7 n" I( b0 k5 [7 x
62.                 '遍历横断面多段线
    " w# q1 q3 C$ V; ?2 c9 z
63.                 For Each Ent多段线 In Ss多段线
    
64.                     '检查多段线与中心线是否存在交点,如存在交点则输出数据
    
65.                     Var中心线与多段线交点 = Lin中心线.IntersectWith(Ent多段线, acExtendNone)
    4 n* A1 h$ z9 Z+ F* x
66.                     If UBound(Var中心线与多段线交点) > 0 Then
    & Z' U5 `3 H$ m/ s  _( V7 @
67.                         '提取多段线顶点坐标
    - \" H6 U; L' A) J6 }6 d1 W
68.                         Var多段线顶点 = Ent多段线.Coordinates
    
69.                         '按多段线类型选择读取坐标的方式
    
70.                         If Ent多段线.ObjectName = "AcDb2dPolyline" Then
    
71.                             Int循环步长 = 3
    
72.                         Else
    6 g+ k# `& M. {7 r3 S
73.                             Int循环步长 = 2
    
74.                         End If
    $ j" r; |) Y( |4 g
75.                         '从第一个顶点到倒数第二个顶点,逐点检查相邻顶点间线段的特性
    
76.                         For Int循环变量 = 0 To UBound(Var多段线顶点) - Int循环步长 * 2 + 1 Step Int循环步长
    - A7 |9 G. i2 H$ `/ d
77.                             '提取线段的起,端点
    
78.                             Dbl线段起点(0) = Var多段线顶点(Int循环变量)
    
79.                             Dbl线段起点(1) = Var多段线顶点(Int循环变量 + 1)
    
80.                             Dbl线段端点(0) = Var多段线顶点(Int循环变量 + Int循环步长)
    6 D" C1 C/ G2 X8 h6 A7 S9 x$ A
81.                             Dbl线段端点(1) = Var多段线顶点(Int循环变量 + Int循环步长 + 1)
    
82.                             '提取线段角度
    5 |  J. E. W; g
83.                             Dbl线段角度 = ThisDrawing.Utility.AngleFromXAxis(Dbl线段起点, Dbl线段端点)
    
84.                             '检查角度是否为"边坡",如果是则输出数据
    
85.                             If Dbl线段角度 > 0.05 And Dbl线段角度 < ThisDrawing.Utility.AngleToReal(90, acDegrees) - 0.05 Or _
    8 f$ z3 g! w+ y/ {# G2 {
86.                             Dbl线段角度 > ThisDrawing.Utility.AngleToReal(90, acDegrees) + 0.05 And _
    ; C' t* k  `2 L3 a* `8 h
87.                             Dbl线段角度 < ThisDrawing.Utility.AngleToReal(180, acDegrees) - 0.05 Or _
    
88.                             Dbl线段角度 > ThisDrawing.Utility.AngleToReal(180, acDegrees) + 0.05 And _
    9 A: T: j) o5 x7 b7 V
89.                             Dbl线段角度 < ThisDrawing.Utility.AngleToReal(270, acDegrees) - 0.05 Or _
    . j* H) ^5 C& J( H( X4 o' i0 X
90.                             Dbl线段角度 > ThisDrawing.Utility.AngleToReal(270, acDegrees) + 0.05 And _
    
91.                             Dbl线段角度 < ThisDrawing.Utility.AngleToReal(180, acDegrees) * 2 - 0.05 Then
    8 ~, O: ^5 P. `6 y  b1 ~
92.                                 'EXCEL工作表中行号递加
    3 L+ z/ I6 D# O+ Y
93.                                 Int行号 = Int行号 + 1
      M. E  W1 S, u
94.                                 '写入前面记录的桩号
    ! l! z3 ^' ]- B& J" t- a3 D: T
95.                                 .Item(Int行号, 1) = Str桩号
    
96.                                 '判断该线段与中心线水平位置关系,并写入"左右"
    * h) y5 p, y3 m5 P* ]! J
97.                                 If Dbl线段起点(0) < Var中心线下端点(0) Then
    8 o4 R. n& l4 C
98.                                     .Item(Int行号, 2) = "左"
    
99.                                 Else
    8 Y0 D, X2 G9 o1 O' k5 n
100.                                     .Item(Int行号, 3) = "右"
     
101.                                 End If
       Z3 g* L, o. ~. h
102.                                 '写入边坡长度
     * l7 [  m2 v. R" S- y: h4 Q
103.                                 .Item(Int行号, 4) = Sqr((Dbl线段起点(0) - Dbl线段端点(0)) ^ 2 + (Dbl线段起点(1) - Dbl线段端点(1)) ^ 2)
     ( ^# H3 @! w) D( }3 B4 j7 f
104.                                 '写入坡率
     
105.                                 .Item(Int行号, 5) = Abs(1 / Tan(Dbl线段角度))
     % [- n" t& E! y7 e+ f0 |2 ~% x* l
106.                             End If
     
107.                         Next
     : j* M- o4 J. i4 i
108.                         Exit For
     
109.                     End If
     ( _4 c; @6 s8 k8 a
110.                 Next
     ( E0 f8 g( Q5 V& _4 u5 J/ ~. z
111.             Next
     
112.         End With
     $ e- M5 U5 M4 e0 b0 e6 U5 w1 r
113.     End With
     $ D1 R& p: q; \0 ^
114.     '删除用过的选择集
     
115.     Ss中心线.Delete
     . S! c" q! O2 t  A3 r$ Q4 S4 C
116.     Ss文字.Delete
     
117.     Ss多段线.Delete
     
118.     '保存EXCEL文档并退出
     
119.     Excel文档.SaveAs Left(ThisDrawing.FullName, InStrRev(ThisDrawing.FullName, ".") - 1) & ".xls"
     
120.     Excel进程.Quit
     . E7 }4 d" t0 k2 Y
121. End Sub
     - e; X5 x% u/ S4 ~. c9 u# s0 D

复制代码

    在使用此代码之前,务请在VBAIDE界面的"工具"菜单下打开"引用"对话框,正确设置对EXCEL类库的引用.
五.附件是包含上面代码和对EXCEL的引用的dvb文件,由于本人PC中安装的是EXCEL2003程序,如果使用者的EXCEL版本与本人不同,请自行修改引用.
) X0 S9 L7 r( q7 _4 F/ a. _( g+ D3 c
1 l& z! k- r5 }. ~9 M[ 本帖最后由 woaishuijia 于 2010-2-27 06:05 编辑 ]

fengyujin2010

好东西 谢谢

xinxincheng

非常好的，谢谢分享！

soonsos

应该搞个文件列表说明lsp文件各个功能才好呀，楼主。

askada

多谢楼主分享，下来学习

pentenchour

昏，怎么一点都看不懂啊，看似为河道疏浚的断面？