史上最全的lsp程序分享

小书僮 · 发表于 2010-2-17 02:23

哈哈，问题已经解决，看来这里有高手哦^_^

[ 本帖最后由小书僮于 2010-2-27 01:48 编辑 ]

Camello · 发表于 2010-2-17 22:03

只看懂了 B1K46+380 序列
其余未知从何而得

小书僮 · 发表于 2010-2-18 12:22

没懂……我的思路是：1.关闭除横断面以外的其他图层（即只显示横断面红线的长度，注释、原坡面线隐藏）2.编一个LSP程序，全选所有断面后，可以批量测量长度。3.打开桩号、坡率所在图层，用一个程序，把所有横断面的桩号、左右、长度、及坡率批量输入excel。但是编程太难了，我参考了网上许多lsp程序，一头雾水

[ 本帖最后由小书僮于 2010-2-18 12:23 编辑 ]

小书僮 · 发表于 2010-2-24 23:37

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

癫者TT · 发表于 2010-2-25 08:26

我看都没看懂

jiangch9726 · 发表于 2010-2-25 09:30

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

hulij · 发表于 2010-2-25 09:38

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

woaishuijia · 发表于 2010-2-25 11:19

首先声明,由于对楼主所在行业一窍不通,只能通过楼主在帖中提供的信息来推测符合楼主要求的规则和方法,错误和遗漏在所难免,还望谅解,以下内容仅做为意见和建议供楼主参考:
一.由于楼主要求用EXCEL输出,所以用LISP是不合适的,这是VBA的长项;
二.楼主在"2.jpg"中提供的数据样例,疑似来自B1K46+360,而不是B1K46+350(详见附图)

以下按此数据来自B1K46+360看待;
三.初步拟定规则和方法如下:
假定:
1.所有需要处理的图形和注释都在已打开的当前DWG文件的当前布局,且所有图形和注释都在WCS的XY平面上,都是二维的;
2.位于"zhix"图层的所有直线都是某个横断面唯一的"路面中心"线,且所有横断面都有一条"路面中心"线;
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代码如下:

" t0 R' I: q- g. ^7 d; x2 f
Sub HDM()
. ]! c) \: n3 D4 E
Dim Excel进程 As New Excel.Application, Excel文档 As Excel.WorkBook, Excel工作表 As Excel.Worksheet, Int行号 As Integer
( S- W$ S2 ]7 @
Dim Ss中心线 As AcadSelectionSet, Ss多段线 As AcadSelectionSet, Ss文字 As AcadSelectionSet, Ft(1) As Integer, Fd(1) As Variant6 w% e) S$ r1 e$ E
Dim Lin中心线 As AcadLine, Txt文字 As AcadText, Ent多段线 As AcadEntity9 y0 A- a! M4 z( a
Dim Var中心线下端点 As Variant, Dbl文字与中心线最小距离 As Double, Dbl文字与中心线距离 As Double, Str桩号 As String
. `2 t9 l' R! I# b8 I
Dim Var中心线与多段线交点 As Variant, Var多段线顶点 As Variant, Dbl线段起点(2) As Double, Dbl线段端点(2) As Double, Dbl线段角度 As Double; e9 j/ W. @) T5 `0 D
Dim Int循环变量 As Integer, Int循环步长 As Integer9 ^) A! \/ g( d6 v& n! D" P
On Error Resume Next
" u- `- s& @5 d* M9 [9 z% @% ?
'创建三个选择集,分别选择中心线,横断面多段线和包含桩号的单行文字
9 h4 t5 M: _6 m4 c& N0 U
With ThisDrawing.SelectionSets' {2 Z: j: U4 ^1 p! q; u6 }0 w
Set Ss中心线 = .Add("中心线")
/ p% x( `1 O9 Z( T9 K' {
Set Ss文字 = .Add("文字")
2 B, A" e8 E8 C
Set Ss多段线 = .Add("多段线")
( P; B3 E# b" G) L& u n) x
End With7 q) y6 b+ r5 E3 ~8 E4 D7 g
Ft(0) = 0( F" W: ?' }2 ~1 p: c% L6 m# ]
Fd(0) = "LINE", r2 F- Y1 K! ]; d [; {5 Y: B
Ft(1) = 8# X! T* G$ N' R0 c9 D
Fd(1) = "zhix"
1 F; s3 r2 |; j
Ss中心线.Select acSelectionSetAll, , , Ft, Fd
8 E) n6 s" y1 D- w" B/ ?- h
Fd(0) = "TEXT"
5 t0 ?) r+ B7 @. e7 e
Fd(1) = "shuju"
" a& Y: q& D% W2 T3 c/ ^3 Q
Ss文字.Select acSelectionSetAll, , , Ft, Fd
( f1 W8 a/ \ y* |
Fd(0) = "POLYLINE,LWPOLYLINE"
Fd(1) = "sjx"
: k, T' i) t0 v) n7 B( W' K6 h( u
Ss多段线.Select acSelectionSetAll, , , Ft, Fd
6 x% y: }) r& Q" E" i) d; u% T5 J
'创建新EXCEL文档
/ ?0 T O2 }2 X" y
Set Excel文档 = Excel进程.Workbooks.Add
0 ^% Z) t2 ~- y# h$ l" I. E
Set Excel工作表 = Excel文档.ActiveSheet5 o$ T3 G8 j2 w8 k8 ^3 u: V
With Excel工作表: W" K& z7 y9 y( }) a
'修改工作表名称,并在第一行写入表头文字 y1 h" T3 R1 D w. H# ~% h/ T
.Name = "横断面数据"$ N: w' r; u; t" F1 U& V
.Cells.Item(1, 1) = "桩号"
& ?" S! A3 l6 o% y/ ?
.Cells.Item(1, 2) = "位置"
* X. n% {! N2 d8 j! @0 L1 B* H
'合并单元格
! _# q. a) J6 N+ i+ {
.Range("B1:C1").Merge, T1 p' N1 ~8 V
.Cells.Item(1, 4) = "长度"% j3 n. Q! E Y- m
.Cells.Item(1, 5) = "坡率"
0 I' h1 ^; p/ {5 `& I
'设置单元格对齐方式为水平中心对齐0 l2 B2 x5 r3 `' ]" q' A. ^
.Columns("A:E").HorizontalAlignment = xlCenter5 w& x5 f3 Q& p4 h5 @% l; q
Int行号 = 1
) B8 S& x k& p
With .Cells
* K% m1 R2 J2 x9 N& n6 I
'遍历中心线
" L9 d5 `) b" ^1 `
For Each Lin中心线 In Ss中心线 {5 T V0 k1 Y
'提取中心线下端点
' C2 ^$ N( m" m- j
If Lin中心线.StartPoint(1) > Lin中心线.EndPoint(1) Then# g$ r* U5 w# f) i6 M
Var中心线下端点 = Lin中心线.EndPoint0 }9 P2 Q$ q9 {7 w4 a& G% `
Else2 F0 l; g! O, b; ?( C+ X
Var中心线下端点 = Lin中心线.StartPoint( [# l# f2 A/ _4 M! I
End If
5 [+ I& o( R4 _' l! `
'遍历单行文字,找出与中心线对应的桩号并记录
+ I3 R: e E' }
Dbl文字与中心线最小距离 = 0
4 d5 V0 P, v. P+ f! s
For Each Txt文字 In Ss文字! [% ~. C+ l9 o" T
If Txt文字.InsertionPoint(1) < Var中心线下端点(1) Then7 e4 K2 l% m( m5 p3 E
Dbl文字与中心线距离 = Sqr((Var中心线下端点(0) - Txt文字.InsertionPoint(0)) ^ 2 + (Var中心线下端点(1) - Txt文字.InsertionPoint(1)) ^ 2)
% ^, J3 }( Y% s. V/ K5 q7 B4 G
If Dbl文字与中心线最小距离 = 0 Or Dbl文字与中心线距离 < Dbl文字与中心线最小距离 Then$ l# Z" p% B" e5 M$ p
Dbl文字与中心线最小距离 = Dbl文字与中心线距离
( k4 E/ E( N' @7 K: |: h
Str桩号 = Txt文字.TextString
% L* ]& s6 T& l; N
End If
8 F( g7 s3 e& B0 f2 t
End If
+ K/ ]. Q1 Q, U3 C7 K3 }* k
Next: P5 _- c( [# q
'遍历横断面多段线
; s+ h- Z- T0 G! i
For Each Ent多段线 In Ss多段线. y9 X& d: J1 U. @1 a) m" Y
'检查多段线与中心线是否存在交点,如存在交点则输出数据
8 t, h$ Y/ Z$ K2 ]% v
Var中心线与多段线交点 = Lin中心线.IntersectWith(Ent多段线, acExtendNone)
+ x. H1 a. l \4 v* }
If UBound(Var中心线与多段线交点) > 0 Then
. W4 E) c* O6 a' V/ K% d$ i; U; j0 Z
'提取多段线顶点坐标
Y3 R, o4 U: R3 F8 }
Var多段线顶点 = Ent多段线.Coordinates
: ]- D. A2 S* U
'按多段线类型选择读取坐标的方式
" a6 ~" D; Z! v4 e u F
If Ent多段线.ObjectName = "AcDb2dPolyline" Then* Q, g% Y. `6 Z. C% F
Int循环步长 = 3; _; |/ K2 o8 p |$ U
Else) e( J @: |8 W2 | L0 o
Int循环步长 = 2
; x' q9 D( D% |0 e# z
End If
& m* n5 U/ k5 s4 \) S" X
'从第一个顶点到倒数第二个顶点,逐点检查相邻顶点间线段的特性1 X' g8 c/ q2 ?" R
For Int循环变量 = 0 To UBound(Var多段线顶点) - Int循环步长 * 2 + 1 Step Int循环步长3 K) V" |+ V+ t& t2 l
'提取线段的起,端点
0 z; U0 p# ~. Q' ^, H
Dbl线段起点(0) = Var多段线顶点(Int循环变量)- |' d8 u6 w1 w* _' ~( Z" ]* M
Dbl线段起点(1) = Var多段线顶点(Int循环变量 + 1)
: r( R) w; n# r1 D' V
Dbl线段端点(0) = Var多段线顶点(Int循环变量 + Int循环步长)
, v* ?) W: J4 Y3 c3 _' e
Dbl线段端点(1) = Var多段线顶点(Int循环变量 + Int循环步长 + 1)4 L$ j# d$ K6 z0 X8 ^
'提取线段角度" f9 o3 v+ ?8 K/ l+ L9 r! b
Dbl线段角度 = ThisDrawing.Utility.AngleFromXAxis(Dbl线段起点, Dbl线段端点)
9 i2 j4 ^; c) h- U6 c6 i
'检查角度是否为"边坡",如果是则输出数据( `% s9 i: B2 ~7 d( N0 `
If Dbl线段角度 > 0.05 And Dbl线段角度 < ThisDrawing.Utility.AngleToReal(90, acDegrees) - 0.05 Or _
! O: [' C% I W; a
Dbl线段角度 > ThisDrawing.Utility.AngleToReal(90, acDegrees) + 0.05 And _
; z9 p. W# |6 S% m E0 w R \
Dbl线段角度 < ThisDrawing.Utility.AngleToReal(180, acDegrees) - 0.05 Or _: V8 g a, I7 `- d
Dbl线段角度 > ThisDrawing.Utility.AngleToReal(180, acDegrees) + 0.05 And _: f# j! K% w( ?1 Q6 a# F# b. E
Dbl线段角度 < ThisDrawing.Utility.AngleToReal(270, acDegrees) - 0.05 Or _
, k& c# m! ~* X# J" m# p0 }
Dbl线段角度 > ThisDrawing.Utility.AngleToReal(270, acDegrees) + 0.05 And _& r, X' |7 p8 _
Dbl线段角度 < ThisDrawing.Utility.AngleToReal(180, acDegrees) * 2 - 0.05 Then6 R, `0 P/ m% `/ P
'EXCEL工作表中行号递加' g2 B" f) ?: k8 P, R- I
Int行号 = Int行号 + 1
: a+ u$ M4 V H" s9 i) i. Y
'写入前面记录的桩号' @( X8 U* R' O% c" ^9 }
.Item(Int行号, 1) = Str桩号
& ^5 g+ y8 P5 r) E6 ]+ C9 H7 r
'判断该线段与中心线水平位置关系,并写入"左右"
$ Q9 h; _4 g s7 _, D
If Dbl线段起点(0) < Var中心线下端点(0) Then" n$ B. F* n2 Y- G
.Item(Int行号, 2) = "左"
, h2 L: t2 z1 b3 G1 x2 D
Else# F2 F( m% w1 C6 H# y: f
.Item(Int行号, 3) = "右"2 E3 t3 F* E$ I$ X+ r! W
End If( w5 V9 s# W' {6 ]/ v# W4 C
'写入边坡长度3 {9 F; ]# g( u! d& y7 q
.Item(Int行号, 4) = Sqr((Dbl线段起点(0) - Dbl线段端点(0)) ^ 2 + (Dbl线段起点(1) - Dbl线段端点(1)) ^ 2)+ Q! L( J& j" u" O, F' h
'写入坡率' L' H+ ?2 D) S6 u5 G
.Item(Int行号, 5) = Abs(1 / Tan(Dbl线段角度))0 G% a% m+ | g5 ~( l9 ~, \( r
End If7 K$ B; \4 d$ N0 I4 l: Q" L+ E
Next
" U( b' f# s; s2 y7 T
Exit For9 ~% O9 w+ \6 s' I% u! v- u# ~
End If
. s+ d" l# f3 ]. z9 ~
Next
; D. K- D/ L$ A4 D" L6 t, P! n; @
Next. P! \+ P5 A- G2 e1 d+ H
End With8 n: e# ]' o7 N# R
End With# ?: W+ T9 F6 \5 K' }
'删除用过的选择集
) Y m" Y+ [8 k- t. {( G
Ss中心线.Delete( U! _4 l5 O9 U: ^5 A6 H
Ss文字.Delete
& F! P5 [ X' `: |3 f
Ss多段线.Delete
# _8 {0 l+ u8 H- R0 O' ^
'保存EXCEL文档并退出
8 @! K5 ^# ]$ h
Excel文档.SaveAs Left(ThisDrawing.FullName, InStrRev(ThisDrawing.FullName, ".") - 1) & ".xls"4 M, r- ~* w3 `4 w h6 w* p: ~* H
Excel进程.Quit3 d8 B5 o3 Y5 c& {& F
End Sub4 y* A2 ^( |; x) E. S5 Q8 W

复制代码

在使用此代码之前,务请在VBAIDE界面的"工具"菜单下打开"引用"对话框,正确设置对EXCEL类库的引用.
五.附件是包含上面代码和对EXCEL的引用的dvb文件,由于本人PC中安装的是EXCEL2003程序,如果使用者的EXCEL版本与本人不同,请自行修改引用.

[ 本帖最后由 woaishuijia 于 2010-2-27 06:05 编辑 ]

fengyujin2010 · 发表于 2010-3-7 17:18

好东西谢谢

xinxincheng · 发表于 2010-3-7 21:22

非常好的，谢谢分享！

soonsos · 发表于 2010-3-10 14:33

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

askada · 发表于 2010-3-10 14:52

多谢楼主分享，下来学习

sun229534919 · 发表于 2010-3-10 17:03

提示: 作者被禁止或删除内容自动屏蔽

sun229534919 · 发表于 2010-3-10 17:15

提示: 作者被禁止或删除内容自动屏蔽

pentenchour · 发表于 2010-3-10 17:38

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

		自动登录	找回密码
密码			立即注册

sun229534919 sun229534919 当前离线积分 8	发表于 2010-3-10 17:03 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽
sun229534919 sun229534919 当前离线积分 8
	回复支持反对举报

sun229534919 sun229534919 当前离线积分 8	发表于 2010-3-10 17:15 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽
sun229534919 sun229534919 当前离线积分 8
	回复支持反对举报

[求助] 史上最全的lsp程序分享

本帖子中包含更多资源

回复 #2 Camello 的帖子

本帖子中包含更多资源

回复 #1 小书僮的帖子

回复 #1 小书僮的帖子

[求助] 史上最全的lsp程序分享

本帖子中包含更多资源

回复 #2 Camello 的帖子

本帖子中包含更多资源

回复 #1 小书僮 的帖子

回复 #1 小书僮 的帖子

回复 #1 小书僮的帖子

回复 #1 小书僮的帖子