史上最全的lsp程序分享

小书僮

哈哈，问题已经解决，看来这里有高手哦^_^
: A. r) X) s/ V- A% F
[ 本帖最后由 小书僮 于 2010-2-27 01:48 编辑 ]

Camello

只看懂了 B1K46+380 序列
- `& f: S1 Z/ ?5 a3 M% S( L. H其余未知从何而得

小书僮

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

小书僮

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

癫者TT

我看都没看懂

jiangch9726

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

hulij

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

woaishuijia

首先声明,由于对楼主所在行业一窍不通,只能通过楼主在帖中提供的信息来推测符合楼主要求的规则和方法,错误和遗漏在所难免,还望谅解,以下内容仅做为意见和建议供楼主参考:
3 s# I  K% k' L; v一.由于楼主要求用EXCEL输出,所以用LISP是不合适的,这是VBA的长项;
  n' d0 ]0 [9 Q1 f二.楼主在"2.jpg"中提供的数据样例,疑似来自B1K46+360,而不是B1K46+350(详见附图)
! W  u4 K" p7 o/ ?1 w' ^' ^6 Z
/ {6 K- u3 Q5 |0 X/ J  E; L4 E
    以下按此数据来自B1K46+360看待;
三.初步拟定规则和方法如下:
    假定:
    1.所有需要处理的图形和注释都在已打开的当前DWG文件的当前布局,且所有图形和注释都在WCS的XY平面上,都是二维的;
    2.位于"zhix"图层的所有直线都是某个横断面唯一的"路面中心"线,且所有横断面都有一条"路面中心"线;
: n- H( m& i4 a2 X    3.每一条"路面中心"线都对应存在一个或多个Y座标小于"路面中心"线下端点Y座标的,位于"shuju"图层的单行文字,其中与"路面中心"线下端点几何距离最近者是该断面的"桩号",按其全部文字内容输出"桩号"数据;
    4.每一条"路面中心"线都有一条且仅有一条代表横截面的位于"sjx"图层的二维多段线与其相交;
    5.由于在图上测量得知"路面"部分最大斜度为1:0.03,所以,该多段线中角度为±0.05弧度,π/2±0.05弧度,π±0.05弧度和3π/2±0.05弧度的线段均不予理会,其它线段做为"边坡"看待,并按其与中心线的水平位置关系输出其"左右"数据,按其实测长度输出其"长度"数据,按其角度的余切值的绝对值输出"坡率"数据;
    6.输出的"xls"文件的路径和文件名,除扩展名外其它都与"dwg"文档相同
四.按以下规则编写的VBA代码如下:

1. 
   3 z2 j2 T( k' D- \5 s  N
2. Sub HDM()
   3 N7 ]& ^4 c' X3 E5 x1 W% ]
3.     Dim Excel进程 As New Excel.Application, Excel文档 As Excel.WorkBook, Excel工作表 As Excel.Worksheet, Int行号 As Integer
   + ~: N: L: d) @. F; |
4.     Dim Ss中心线 As AcadSelectionSet, Ss多段线 As AcadSelectionSet, Ss文字 As AcadSelectionSet, Ft(1) As Integer, Fd(1) As Variant
   
5.     Dim Lin中心线 As AcadLine, Txt文字 As AcadText, Ent多段线 As AcadEntity
   . O1 x, U3 N5 g
6.     Dim Var中心线下端点 As Variant, Dbl文字与中心线最小距离 As Double, Dbl文字与中心线距离 As Double, Str桩号 As String
   % s9 [9 I. u& {5 [. D# P
7.     Dim Var中心线与多段线交点 As Variant, Var多段线顶点 As Variant, Dbl线段起点(2) As Double, Dbl线段端点(2) As Double, Dbl线段角度 As Double
   / s# |5 [4 \2 ~' I. [6 `* @1 f0 G
8.     Dim Int循环变量 As Integer, Int循环步长 As Integer
   " j. K- C+ Z# Q, h& @
9.     On Error Resume Next
   
10.     '创建三个选择集,分别选择中心线,横断面多段线和包含桩号的单行文字
    
11.     With ThisDrawing.SelectionSets
    
12.         Set Ss中心线 = .Add("中心线")
    
13.         Set Ss文字 = .Add("文字")
    
14.         Set Ss多段线 = .Add("多段线")
    
15.     End With
    1 Y2 s% `1 a6 h1 V0 @5 `! @- A
16.     Ft(0) = 0
    . O& l/ J. f! S& r* O. f
17.     Fd(0) = "LINE"
    * x9 d, o3 n- c4 T  M
18.     Ft(1) = 8
    
19.     Fd(1) = "zhix"
    3 Z, O" M* I  V6 Y
20.     Ss中心线.Select acSelectionSetAll, , , Ft, Fd
    
21.     Fd(0) = "TEXT"
    % v% T! p2 F, Q5 N
22.     Fd(1) = "shuju"
    7 P7 ?. K) ]' e
23.     Ss文字.Select acSelectionSetAll, , , Ft, Fd
    
24.     Fd(0) = "POLYLINE,LWPOLYLINE"
    
25.     Fd(1) = "sjx"
    * A: `: G/ Y2 H& y1 ?1 r* k
26.     Ss多段线.Select acSelectionSetAll, , , Ft, Fd
    
27.     '创建新EXCEL文档
    
28.     Set Excel文档 = Excel进程.Workbooks.Add
    4 A4 }. G: j2 z! P7 l
29.     Set Excel工作表 = Excel文档.ActiveSheet
    5 `% D2 I) [7 K, G1 w. G* M
30.     With Excel工作表
    . O4 T9 m; s" E7 u! V! n7 l
31.         '修改工作表名称,并在第一行写入表头文字
    4 l5 J; z( F' i: ~& J  F
32.         .Name = "横断面数据"
    / o  I% Q( z& T0 w
33.         .Cells.Item(1, 1) = "桩号"
    4 v# M* Z6 {% B
34.         .Cells.Item(1, 2) = "位置"
    
35.         '合并单元格
    
36.         .Range("B1:C1").Merge
    ( k& Y4 e$ k3 t0 k. U
37.         .Cells.Item(1, 4) = "长度"
    
38.         .Cells.Item(1, 5) = "坡率"
    , D; ]: i. Q7 d
39.         '设置单元格对齐方式为水平中心对齐
    * Y3 }% |/ u. S/ R: h5 D
40.         .Columns("A:E").HorizontalAlignment = xlCenter
    
41.         Int行号 = 1
    
42.         With .Cells
    
43.             '遍历中心线
    
44.             For Each Lin中心线 In Ss中心线
    
45.                 '提取中心线下端点
    0 c/ e, S3 T4 Y9 c4 J8 T+ _# N# w
46.                 If Lin中心线.StartPoint(1) > Lin中心线.EndPoint(1) Then
    
47.                     Var中心线下端点 = Lin中心线.EndPoint
    7 Y" F, [3 v! o$ [% x8 B) `
48.                 Else
    2 H* r8 b- O0 A, \0 A+ ^2 U
49.                     Var中心线下端点 = Lin中心线.StartPoint
    
50.                 End If
    3 f8 v# M& E+ }% x" _" B% z. V  Y, V7 h
51.                 '遍历单行文字,找出与中心线对应的桩号并记录
    + A* p* R' C' i. a5 `$ L
52.                 Dbl文字与中心线最小距离 = 0
    
53.                 For Each Txt文字 In Ss文字
    
54.                     If Txt文字.InsertionPoint(1) < Var中心线下端点(1) Then
    
55.                         Dbl文字与中心线距离 = Sqr((Var中心线下端点(0) - Txt文字.InsertionPoint(0)) ^ 2 + (Var中心线下端点(1) - Txt文字.InsertionPoint(1)) ^ 2)
    
56.                         If Dbl文字与中心线最小距离 = 0 Or Dbl文字与中心线距离 < Dbl文字与中心线最小距离 Then
    
57.                             Dbl文字与中心线最小距离 = Dbl文字与中心线距离
    2 Y  l2 d2 l' o( u* z: g4 K
58.                             Str桩号 = Txt文字.TextString
    
59.                         End If
    
60.                     End If
    ; u8 F( x' o, p) m4 {4 I5 E/ B/ j
61.                 Next
    
62.                 '遍历横断面多段线
    ' ]: v% {3 s; b  t4 j/ ?: ~2 f
63.                 For Each Ent多段线 In Ss多段线
    
64.                     '检查多段线与中心线是否存在交点,如存在交点则输出数据
    0 n% G0 N( E4 C
65.                     Var中心线与多段线交点 = Lin中心线.IntersectWith(Ent多段线, acExtendNone)
    ) x3 U+ x' c5 D, C
66.                     If UBound(Var中心线与多段线交点) > 0 Then
    
67.                         '提取多段线顶点坐标
    
68.                         Var多段线顶点 = Ent多段线.Coordinates
    
69.                         '按多段线类型选择读取坐标的方式
    
70.                         If Ent多段线.ObjectName = "AcDb2dPolyline" Then
    
71.                             Int循环步长 = 3
    . s' R& e  b1 ^- Z) D! D4 Y
72.                         Else
    
73.                             Int循环步长 = 2
    8 l6 Y- M- [' B3 p* o
74.                         End If
    $ V- O. {6 {9 |, ?+ y( ~, n
75.                         '从第一个顶点到倒数第二个顶点,逐点检查相邻顶点间线段的特性
    
76.                         For Int循环变量 = 0 To UBound(Var多段线顶点) - Int循环步长 * 2 + 1 Step Int循环步长
    ( O6 v! ]0 U' d
77.                             '提取线段的起,端点
    ! u' m# i; B1 n/ v  J$ c* y
78.                             Dbl线段起点(0) = Var多段线顶点(Int循环变量)
      }; q8 ^5 \: b5 T3 b5 s& r
79.                             Dbl线段起点(1) = Var多段线顶点(Int循环变量 + 1)
    
80.                             Dbl线段端点(0) = Var多段线顶点(Int循环变量 + Int循环步长)
    0 g2 J2 h7 D5 t) ^& J" o4 o
81.                             Dbl线段端点(1) = Var多段线顶点(Int循环变量 + Int循环步长 + 1)
    
82.                             '提取线段角度
    3 m, Q2 F* }8 l* ?. G
83.                             Dbl线段角度 = ThisDrawing.Utility.AngleFromXAxis(Dbl线段起点, Dbl线段端点)
    ' a) @  H  V2 v- V
84.                             '检查角度是否为"边坡",如果是则输出数据
    $ ]4 i& l8 z; F/ N- E" |
85.                             If Dbl线段角度 > 0.05 And Dbl线段角度 < ThisDrawing.Utility.AngleToReal(90, acDegrees) - 0.05 Or _
    / Z+ R1 d; O/ V4 n* L
86.                             Dbl线段角度 > ThisDrawing.Utility.AngleToReal(90, acDegrees) + 0.05 And _
    2 `1 m% t# G5 S
87.                             Dbl线段角度 < ThisDrawing.Utility.AngleToReal(180, acDegrees) - 0.05 Or _
    
88.                             Dbl线段角度 > ThisDrawing.Utility.AngleToReal(180, acDegrees) + 0.05 And _
    
89.                             Dbl线段角度 < ThisDrawing.Utility.AngleToReal(270, acDegrees) - 0.05 Or _
    . a" I6 `1 y9 F1 r9 K! D$ R
90.                             Dbl线段角度 > ThisDrawing.Utility.AngleToReal(270, acDegrees) + 0.05 And _
    
91.                             Dbl线段角度 < ThisDrawing.Utility.AngleToReal(180, acDegrees) * 2 - 0.05 Then
    3 j) q1 }4 ]- [. ^0 x  @9 b4 a
92.                                 'EXCEL工作表中行号递加
    ) S9 {  ]  |$ {+ t
93.                                 Int行号 = Int行号 + 1
    8 C. s( k  I" m, Y
94.                                 '写入前面记录的桩号
    
95.                                 .Item(Int行号, 1) = Str桩号
    
96.                                 '判断该线段与中心线水平位置关系,并写入"左右"
    
97.                                 If Dbl线段起点(0) < Var中心线下端点(0) Then
    ! u' W1 M; y; b  C
98.                                     .Item(Int行号, 2) = "左"
    
99.                                 Else
    
100.                                     .Item(Int行号, 3) = "右"
     
101.                                 End If
     / [, g* ?! E, [, ]/ T
102.                                 '写入边坡长度
     
103.                                 .Item(Int行号, 4) = Sqr((Dbl线段起点(0) - Dbl线段端点(0)) ^ 2 + (Dbl线段起点(1) - Dbl线段端点(1)) ^ 2)
     , ?( v& a1 s& W$ M1 t, b
104.                                 '写入坡率
     ( x* o2 P7 o3 L8 e+ U
105.                                 .Item(Int行号, 5) = Abs(1 / Tan(Dbl线段角度))
     
106.                             End If
     # K' J- L* E  d+ h" P( w2 c" F1 \
107.                         Next
     3 _; k* I4 g1 }, C$ L
108.                         Exit For
     ' Z: p: e% S# T
109.                     End If
     
110.                 Next
     
111.             Next
     , w- d) U# L" ^9 F! X- e7 `4 N
112.         End With
     
113.     End With
     . _7 r, F6 O5 z; ^+ \4 W8 L
114.     '删除用过的选择集
     
115.     Ss中心线.Delete
     6 L2 Z2 }" z1 o- B% ]
116.     Ss文字.Delete
     1 V, ?3 s2 X, p0 V1 Z% _( n
117.     Ss多段线.Delete
     / z( \& Z9 ^* h( O$ U! M+ ?
118.     '保存EXCEL文档并退出
     
119.     Excel文档.SaveAs Left(ThisDrawing.FullName, InStrRev(ThisDrawing.FullName, ".") - 1) & ".xls"
     
120.     Excel进程.Quit
     
121. End Sub
     

复制代码

    在使用此代码之前,务请在VBAIDE界面的"工具"菜单下打开"引用"对话框,正确设置对EXCEL类库的引用.
五.附件是包含上面代码和对EXCEL的引用的dvb文件,由于本人PC中安装的是EXCEL2003程序,如果使用者的EXCEL版本与本人不同,请自行修改引用.
( g# s- m+ J$ }
[ 本帖最后由 woaishuijia 于 2010-2-27 06:05 编辑 ]

fengyujin2010

好东西 谢谢

xinxincheng

非常好的，谢谢分享！

soonsos

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

askada

多谢楼主分享，下来学习

pentenchour

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