紧急求助,恳请各位大哥帮忙!!!
我想摘直线与多段线的交点,将数据存到文本文件中已知:
1.直线两端点坐标,直线名,如附件1.txt所示
格式为:直线名,起点x,起点y,终点x,终点y
2.多段线在cad图中,如2.dwg所示
求:
每条直线与所相交的多段线的所有交点坐标
输出城文本格式
格式为:
cs001(直线名)
x1,y1(交点坐标),xxxx(多段线所在层名)
x1,y1(交点坐标),xxxx(多段线所在层名)
.............
cs002
见附件3.txt
希望各位大哥帮忙给写个完整的vba程序,小弟自己试验了好久都不行
直线用它的StartPoint和EndPoint分别获取起点和终点坐标，用Layer返回层名。
判断相交使用IntersectWith方法。
访问或创建文件：Open，写入文件Print或者Write，关闭文件：Close。
Print # 语句示例
本示例使用 Print # 语句将数据写入一个文件。
Open "TESTFILE" For Output As #1 ' 打开输出文件。
Print #1, "This is a test" ' 将文本数据写入文件。
Print #1, ' 将空白行写入文件。
Print #1, "Zone 1"； Tab ； "Zone 2" ' 数据写入两个区（print zones）。
Print #1, "Hello" ； " " ； "World" ' 以空格隔开两个字符串。
Print #1, Spc(5) ； "5 leading spaces " ' 在字符串之前写入五个空格。
Print #1, Tab(10) ； "Hello" ' 将数据写在第十列。
' 赋值 Boolean、Date、Null 及 Error 等。
Dim MyBool, MyDate, MyNull, MyError
MyBool = False : MyDate = #February 12, 1969# : MyNull = Null
MyError = CVErr(32767)
' True、False、Null 及 Error 会根据系统的地区设置自动转换格式。
' 日期将以标准的短式日期的格式显示。
Print #1, MyBool ； " is a Boolean value"
Print #1, MyDate ； " is a date"
Print #1, MyNull ； " is a null value"
Print #1, MyError ； " is an error value"
Close #1 ' 关闭文件。
文件操作我会一点
最主要的是我不知道怎样将ModelSpace上的多段线提取出来与直线求教点
我对选择集很不熟悉,因为我只会一点vb,不会vba,:-(
使用下面语句时,我每次都找不到多段线
ZoomAll
intPoints = lineObj.IntersectWith(polylineObj, acExtendNone)
所以还请efan2000斑竹和各位大虾帮忙做一个完整的程序好吗?? 选择实体用
object.GetEntity Object, PickedPoint[, Prompt]
Object
Utility
The object or objects this method applies to.
Object
Object; output-only
The picked object. Can be one of any of the Drawing Objects.
PickedPoint
Variant (three-element array of doubles); output-only
A 3D WCS coordinate specifying the point that was selected.
Prompt
Variant (string); input-only; optional
The text to display that prompts the user for input.
Sub Example_Select()
' 创建选择集
Dim ssetObj As AcadSelectionSet
On Error Resume Next
Set ssetObj = ThisDrawing.SelectionSets("SSET")
If Err Then
Err.Clear
Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")
End If
ssetObj.Clear
'构造过滤机制
Dim groupCode(0) As Integer
Dim dataCode(0) As Variant
groupCode(0) = 0
dataCode(0) = "lwPolyline"
ssetObj.Select acSelectionSetAll, , , groupCode, dataCode
'更好的方法是只选中与直线外框相交或者位于其中的对象
'获取直线的外框
Dim corner1 As Variant
Dim corner2 As Variant
'Dim lineObj As AcadLine
'Set lineObj = ThisDrawing.ModelSpace(0)
lineObj.GetBoundingBox corner1, corner2 'lineObj为位于0层的直线
ssetObj.Select acSelectionSetCrossing, corner1, corner2, groupCode, dataCode
'枚举交点，判断是否相交
Dim Pts As Variant
Dim i As Integer
Dim j As Integer
For i = 0 To ssetObj.Count - 1
Pts = ssetObj(i).IntersectWith(lineObj, acExtendNone)
If Not IsEmpty(Pts) Then
Debug.Print "多段线（" & ssetObj(i).Handle & "）与直线（" & lineObj.Handle & "）相交"
For j = 0 To UBound(Pts) Step 3
Debug.Print "交点：" & Pts(j) & "," & Pts(j + 1) & "," & Pts(j + 2)
Next
End If
Next
End Sub
多段线（2D）与直线（2B）相交
交点：128.258445252942,175.187446678566,0
多段线（2C）与直线（2B）相交
交点：124.856166338691,177.858572554345,0
交点：146.95855737489,160.506006788479,0
交点：176.484246297653,137.325417051576,0
非常感谢,试验中ing
页:
[1]