紧急求助,恳请各位大哥帮忙!!!

yu-gn

我想摘直线与多段线的交点,将数据存到文本文件中
已知:
1.直线两端点坐标,直线名,如附件1.txt所示
    格式为:直线名,起点x,起点y,终点x,终点y
2.多段线在cad图中,如2.dwg所示
求:
每条直线与所相交的多段线的所有交点坐标
输出城文本格式
     格式为:
cs001(直线名)
x1,y1(交点坐标),xxxx(多段线所在层名)
x1,y1(交点坐标),xxxx(多段线所在层名)
.............
cs002
见附件3.txt
希望各位大哥帮忙给写个完整的vba程序,小弟自己试验了好久都不行

efan2000

直线用它的StartPoint和EndPoint分别获取起点和终点坐标，用Layer返回层名。
判断相交使用IntersectWith方法。
访问或创建文件：Open，写入文件Print或者Write，关闭文件：Close。

2. 
   
3. Print # 语句示例
   
4. 
   
5. 本示例使用 Print # 语句将数据写入一个文件。
   
6. 
   
7. Open "TESTFILE" For Output As #1        ' 打开输出文件。
   
8. Print #1, "This is a test"        ' 将文本数据写入文件。
   
9. Print #1,        ' 将空白行写入文件。
   
10. Print #1, "Zone 1"； Tab ； "Zone 2"        ' 数据写入两个区（print zones）。
    
11. Print #1, "Hello" ； " " ； "World"        ' 以空格隔开两个字符串。
    
12. Print #1, Spc(5) ； "5 leading spaces "        ' 在字符串之前写入五个空格。
    
13. 
    
14. Print #1, Tab(10) ； "Hello"        ' 将数据写在第十列。
    
15. 
    
16. ' 赋值 Boolean、Date、Null 及 Error 等。
    
17. Dim MyBool, MyDate, MyNull, MyError
    
18. MyBool = False : MyDate = #February 12, 1969# : MyNull = Null
    
19. MyError = CVErr(32767)
    
20. ' True、False、Null 及 Error 会根据系统的地区设置自动转换格式。
    
21. ' 日期将以标准的短式日期的格式显示。
    
22. Print #1, MyBool ； " is a Boolean value"
    
23. 
    
24. Print #1, MyDate ； " is a date"
    
25. Print #1, MyNull ； " is a null value"
    
26. Print #1, MyError ； " is an error value"
    
27. Close #1        ' 关闭文件。
    

<br /> Print # 语句示例<br /> <br /> 本示例使用 Print # 语句将数据写入一个文件。<br /> <br /> Open "TESTFILE" For Output As #1        ' 打开输出文件。<br /> Print #1, "This is a test"        ' 将文本数据写入文件。<br /> Print #1,        ' 将空白行写入文件。<br /> Print #1, "Zone 1"； Tab ； "Zone 2"        ' 数据写入两个区（print zones）。<br /> Print #1, "Hello" ； " " ； "World"        ' 以空格隔开两个字符串。<br /> Print #1, Spc(5) ； "5 leading spaces "        ' 在字符串之前写入五个空格。<br /> <br /> Print #1, Tab(10) ； "Hello"        ' 将数据写在第十列。<br /> <br /> ' 赋值 Boolean、Date、Null 及 Error 等。<br /> Dim MyBool, MyDate, MyNull, MyError<br /> MyBool = False : MyDate = #February 12, 1969# : MyNull = Null<br /> MyError = CVErr(32767)<br /> ' True、False、Null 及 Error 会根据系统的地区设置自动转换格式。<br /> ' 日期将以标准的短式日期的格式显示。<br /> Print #1, MyBool ； " is a Boolean value"<br /> <br /> Print #1, MyDate ； " is a date"<br /> Print #1, MyNull ； " is a null value"<br /> Print #1, MyError ； " is an error value"<br /> Close #1        ' 关闭文件。<br />

yu-gn

文件操作我会一点
最主要的是我不知道怎样将ModelSpace上的多段线提取出来与直线求教点
我对选择集很不熟悉,因为我只会一点vb,不会vba,:-(
使用下面语句时,我每次都找不到多段线
ZoomAll
intPoints = lineObj.IntersectWith(polylineObj, acExtendNone)
所以还请efan2000斑竹和各位大虾帮忙做一个完整的程序好吗??

subtlation

选择实体用

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.

efan2000

2. 
   
3. Sub Example_Select()
   
4.    
   
5.     ' 创建选择集
   
6.     Dim ssetObj As AcadSelectionSet
   
7.    
   
8.     On Error Resume Next
   
9.     Set ssetObj = ThisDrawing.SelectionSets("SSET")
   
10.     If Err Then
    
11.         Err.Clear
    
12.         Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")
    
13.     End If
    
14.     ssetObj.Clear
    
15.    
    
16.     '构造过滤机制
    
17.     Dim groupCode(0) As Integer
    
18.     Dim dataCode(0) As Variant
    
19.     groupCode(0) = 0
    
20.     dataCode(0) = "lwPolyline"
    
21. 
    
22.     ssetObj.Select acSelectionSetAll, , , groupCode, dataCode
    
23.    
    
24.     '更好的方法是只选中与直线外框相交或者位于其中的对象
    
25.    
    
26.     '获取直线的外框
    
27.     Dim corner1 As Variant
    
28.     Dim corner2 As Variant
    
29.     'Dim lineObj As AcadLine
    
30.     'Set lineObj = ThisDrawing.ModelSpace(0)
    
31.     lineObj.GetBoundingBox corner1, corner2 'lineObj为位于0层的直线
    
32.    
    
33.     ssetObj.Select acSelectionSetCrossing, corner1, corner2, groupCode, dataCode
    
34.    
    
35.      '枚举交点，判断是否相交
    
36.      Dim Pts As Variant
    
37.      Dim i As Integer
    
38.      Dim j As Integer
    
39.      For i = 0 To ssetObj.Count - 1
    
40.         Pts = ssetObj(i).IntersectWith(lineObj, acExtendNone)
    
41.         If Not IsEmpty(Pts) Then
    
42.             Debug.Print "多段线（" & ssetObj(i).Handle & "）与直线（" & lineObj.Handle & "）相交"
    
43.             For j = 0 To UBound(Pts) Step 3
    
44.                 Debug.Print "交点：" & Pts(j) & "," & Pts(j + 1) & "," & Pts(j + 2)
    
45.             Next
    
46.         End If
    
47.     Next
    
48. End Sub
    
49. 
    
50. 多段线（2D）与直线（2B）相交
    
51. 交点：128.258445252942,175.187446678566,0
    
52. 多段线（2C）与直线（2B）相交
    
53. 交点：124.856166338691,177.858572554345,0
    
54. 交点：146.95855737489,160.506006788479,0
    
55. 交点：176.484246297653,137.325417051576,0
    

<br /> Sub Example_Select()<br />     <br />     ' 创建选择集<br />     Dim ssetObj As AcadSelectionSet<br />     <br />     On Error Resume Next<br />     Set ssetObj = ThisDrawing.SelectionSets("SSET")<br />     If Err Then<br />         Err.Clear<br />         Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")<br />     End If<br />     ssetObj.Clear<br />     <br />     '构造过滤机制<br />     Dim groupCode(0) As Integer<br />     Dim dataCode(0) As Variant<br />     groupCode(0) = 0<br />     dataCode(0) = "lwPolyline"<br /> <br />     ssetObj.Select acSelectionSetAll, , , groupCode, dataCode<br />     <br />     '更好的方法是只选中与直线外框相交或者位于其中的对象<br />     <br />     '获取直线的外框<br />     Dim corner1 As Variant<br />     Dim corner2 As Variant<br />     'Dim lineObj As AcadLine<br />     'Set lineObj = ThisDrawing.ModelSpace(0)<br />     lineObj.GetBoundingBox corner1, corner2 'lineObj为位于0层的直线<br />     <br />     ssetObj.Select acSelectionSetCrossing, corner1, corner2, groupCode, dataCode<br />     <br />      '枚举交点，判断是否相交<br />      Dim Pts As Variant<br />      Dim i As Integer<br />      Dim j As Integer<br />      For i = 0 To ssetObj.Count - 1<br />         Pts = ssetObj(i).IntersectWith(lineObj, acExtendNone)<br />         If Not IsEmpty(Pts) Then<br />             Debug.Print "多段线（" & ssetObj(i).Handle & "）与直线（" & lineObj.Handle & "）相交"<br />             For j = 0 To UBound(Pts) Step 3<br />                 Debug.Print "交点：" & Pts(j) & "," & Pts(j + 1) & "," & Pts(j + 2)<br />             Next<br />         End If<br />     Next<br /> End Sub<br /> <br /> 多段线（2D）与直线（2B）相交<br /> 交点：128.258445252942,175.187446678566,0<br /> 多段线（2C）与直线（2B）相交<br /> 交点：124.856166338691,177.858572554345,0<br /> 交点：146.95855737489,160.506006788479,0<br /> 交点：176.484246297653,137.325417051576,0<br />

yu-gn

非常感谢,试验中ing