史上最全的lsp程序分享
哈哈，问题已经解决，看来这里有高手哦^_^[ 本帖最后由 小书僮 于 2010-2-27 01:48 编辑 ] 只看懂了 B1K46+380 序列
其余未知从何而得
回复 #2 Camello 的帖子
没懂……我的思路是：1.关闭除横断面以外的其他图层（即只显示横断面红线的长度，注释、原坡面线隐藏）2.编一个LSP程序，全选所有断面后，可以批量测量长度。3.打开桩号、坡率所在图层，用一个程序，把所有横断面的桩号、左右、长度、及坡率批量输入excel。但是编程太难了，我参考了网上许多lsp程序，一头雾水[ 本帖最后由 小书僮 于 2010-2-18 12:23 编辑 ] :'( 哪位高手帮一下忙嘛……不然太累了 我看都没看懂:'( 怎么这里有那么多的好东西啊，真的要多来看看 怎么这里有那么多的好东西啊，真的要多来看看;P 首先声明,由于对楼主所在行业一窍不通,只能通过楼主在帖中提供的信息来推测符合楼主要求的规则和方法,错误和遗漏在所难免,还望谅解,以下内容仅做为意见和建议供楼主参考:
一.由于楼主要求用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代码如下:
Sub HDM()
Dim Excel进程 As New Excel.Application, Excel文档 As Excel.WorkBook, Excel工作表 As Excel.Worksheet, Int行号 As Integer
Dim Ss中心线 As AcadSelectionSet, Ss多段线 As AcadSelectionSet, Ss文字 As AcadSelectionSet, Ft(1) As Integer, Fd(1) As Variant
Dim Lin中心线 As AcadLine, Txt文字 As AcadText, Ent多段线 As AcadEntity
Dim Var中心线下端点 As Variant, Dbl文字与中心线最小距离 As Double, Dbl文字与中心线距离 As Double, Str桩号 As String
Dim Var中心线与多段线交点 As Variant, Var多段线顶点 As Variant, Dbl线段起点(2) As Double, Dbl线段端点(2) As Double, Dbl线段角度 As Double
Dim Int循环变量 As Integer, Int循环步长 As Integer
On Error Resume Next
'创建三个选择集,分别选择中心线,横断面多段线和包含桩号的单行文字
With ThisDrawing.SelectionSets
Set Ss中心线 = .Add("中心线")
Set Ss文字 = .Add("文字")
Set Ss多段线 = .Add("多段线")
End With
Ft(0) = 0
Fd(0) = "LINE"
Ft(1) = 8
Fd(1) = "zhix"
Ss中心线.Select acSelectionSetAll, , , Ft, Fd
Fd(0) = "TEXT"
Fd(1) = "shuju"
Ss文字.Select acSelectionSetAll, , , Ft, Fd
Fd(0) = "POLYLINE,LWPOLYLINE"
Fd(1) = "sjx"
Ss多段线.Select acSelectionSetAll, , , Ft, Fd
'创建新EXCEL文档
Set Excel文档 = Excel进程.Workbooks.Add
Set Excel工作表 = Excel文档.ActiveSheet
With Excel工作表
'修改工作表名称,并在第一行写入表头文字
.Name = "横断面数据"
.Cells.Item(1, 1) = "桩号"
.Cells.Item(1, 2) = "位置"
'合并单元格
.Range("B1:C1").Merge
.Cells.Item(1, 4) = "长度"
.Cells.Item(1, 5) = "坡率"
'设置单元格对齐方式为水平中心对齐
.Columns("A:E").HorizontalAlignment = xlCenter
Int行号 = 1
With .Cells
'遍历中心线
For Each Lin中心线 In Ss中心线
'提取中心线下端点
If Lin中心线.StartPoint(1) > Lin中心线.EndPoint(1) Then
Var中心线下端点 = Lin中心线.EndPoint
Else
Var中心线下端点 = Lin中心线.StartPoint
End If
'遍历单行文字,找出与中心线对应的桩号并记录
Dbl文字与中心线最小距离 = 0
For Each Txt文字 In Ss文字
If Txt文字.InsertionPoint(1) < Var中心线下端点(1) Then
Dbl文字与中心线距离 = Sqr((Var中心线下端点(0) - Txt文字.InsertionPoint(0)) ^ 2 + (Var中心线下端点(1) - Txt文字.InsertionPoint(1)) ^ 2)
If Dbl文字与中心线最小距离 = 0 Or Dbl文字与中心线距离 < Dbl文字与中心线最小距离 Then
Dbl文字与中心线最小距离 = Dbl文字与中心线距离
Str桩号 = Txt文字.TextString
End If
End If
Next
'遍历横断面多段线
For Each Ent多段线 In Ss多段线
'检查多段线与中心线是否存在交点,如存在交点则输出数据
Var中心线与多段线交点 = Lin中心线.IntersectWith(Ent多段线, acExtendNone)
If UBound(Var中心线与多段线交点) > 0 Then
'提取多段线顶点坐标
Var多段线顶点 = Ent多段线.Coordinates
'按多段线类型选择读取坐标的方式
If Ent多段线.ObjectName = "AcDb2dPolyline" Then
Int循环步长 = 3
Else
Int循环步长 = 2
End If
'从第一个顶点到倒数第二个顶点,逐点检查相邻顶点间线段的特性
For Int循环变量 = 0 To UBound(Var多段线顶点) - Int循环步长 * 2 + 1 Step Int循环步长
'提取线段的起,端点
Dbl线段起点(0) = Var多段线顶点(Int循环变量)
Dbl线段起点(1) = Var多段线顶点(Int循环变量 + 1)
Dbl线段端点(0) = Var多段线顶点(Int循环变量 + Int循环步长)
Dbl线段端点(1) = Var多段线顶点(Int循环变量 + Int循环步长 + 1)
'提取线段角度
Dbl线段角度 = ThisDrawing.Utility.AngleFromXAxis(Dbl线段起点, Dbl线段端点)
'检查角度是否为"边坡",如果是则输出数据
If Dbl线段角度 > 0.05 And Dbl线段角度 < ThisDrawing.Utility.AngleToReal(90, acDegrees) - 0.05 Or _
Dbl线段角度 > ThisDrawing.Utility.AngleToReal(90, acDegrees) + 0.05 And _
Dbl线段角度 < ThisDrawing.Utility.AngleToReal(180, acDegrees) - 0.05 Or _
Dbl线段角度 > ThisDrawing.Utility.AngleToReal(180, acDegrees) + 0.05 And _
Dbl线段角度 < ThisDrawing.Utility.AngleToReal(270, acDegrees) - 0.05 Or _
Dbl线段角度 > ThisDrawing.Utility.AngleToReal(270, acDegrees) + 0.05 And _
Dbl线段角度 < ThisDrawing.Utility.AngleToReal(180, acDegrees) * 2 - 0.05 Then
'EXCEL工作表中行号递加
Int行号 = Int行号 + 1
'写入前面记录的桩号
.Item(Int行号, 1) = Str桩号
'判断该线段与中心线水平位置关系,并写入"左右"
If Dbl线段起点(0) < Var中心线下端点(0) Then
.Item(Int行号, 2) = "左"
Else
.Item(Int行号, 3) = "右"
End If
'写入边坡长度
.Item(Int行号, 4) = Sqr((Dbl线段起点(0) - Dbl线段端点(0)) ^ 2 + (Dbl线段起点(1) - Dbl线段端点(1)) ^ 2)
'写入坡率
.Item(Int行号, 5) = Abs(1 / Tan(Dbl线段角度))
End If
Next
Exit For
End If
Next
Next
End With
End With
'删除用过的选择集
Ss中心线.Delete
Ss文字.Delete
Ss多段线.Delete
'保存EXCEL文档并退出
Excel文档.SaveAs Left(ThisDrawing.FullName, InStrRev(ThisDrawing.FullName, ".") - 1) & ".xls"
Excel进程.Quit
End Sub
在使用此代码之前,务请在VBAIDE界面的"工具"菜单下打开"引用"对话框,正确设置对EXCEL类库的引用.
五.附件是包含上面代码和对EXCEL的引用的dvb文件,由于本人PC中安装的是EXCEL2003程序,如果使用者的EXCEL版本与本人不同,请自行修改引用.
[ 本帖最后由 woaishuijia 于 2010-2-27 06:05 编辑 ]
回复 #1 小书僮 的帖子
好东西 谢谢:)回复 #1 小书僮 的帖子
非常好的，谢谢分享！ 应该搞个文件列表说明lsp文件各个功能才好呀，楼主。 多谢楼主分享，下来学习:lol 昏，怎么一点都看不懂啊，看似为河道疏浚的断面？
页:
[1]
2