CAD宏如何 提取三维多段线坐标

「已注销」 2016-07-28 02:14:19
请问下,原来是提取普通多段线坐标的宏代码如何修改为提取三维多段线的坐标。
Option Explicit
Sub Test2()
On Error Resume Next
Dim ele As AcadLine
Dim ele1 As AcadLWPolyline
Dim i, j, index As Integer
Dim get3Dpts As Variant
Dim astr As String
Open "F:\EleData.txt" For Output As #1 '文件保存路径,Append是添加,Output是覆盖
index = 0
For i = 0 To ThisDrawing.ModelSpace.Count - 1
If (ThisDrawing.ModelSpace.Item(i).ObjectName = "AcDbline") And (InStr(1, ThisDrawing.ModelSpace.Item(i).Layer, "首曲线") > 0 Or InStr(1, ThisDrawing.ModelSpace.Item(i).Layer, "计曲线") > 0) Then '41、Index 是图层名称,需要根据实际情况修改
index = index + 1 '线段
Set ele = ThisDrawing.ModelSpace.Item(i)
astr = FormatNumber(ele.StartPoint(0), 2, vbFalse, vbFalse, vbFalse) + " " + FormatNumber(ele.StartPoint(1), 2, vbFalse, vbFalse, vbFalse) + " " + FormatNumber(ele.StartPoint(2), 2, vbFalse, vbFalse, vbFalse)
index = index + 1
astr = astr + vbCrLf + FormatNumber(ele.EndPoint(0), 2, vbFalse, vbFalse, vbFalse) + "," + FormatNumber(ele.EndPoint(1), 2, vbFalse, vbFalse, vbFalse) + "," + FormatNumber(ele.EndPoint(2), 2, vbFalse, vbFalse, vbFalse)
Print #1, astr
ElseIf (ThisDrawing.ModelSpace.Item(i).ObjectName = "AcDbPolyline") And (InStr(1, ThisDrawing.ModelSpace.Item(i).Layer, "首曲线") > 0 Or InStr(1, ThisDrawing.ModelSpace.Item(i).Layer, "计曲线") > 0) Then '41、Index 是图层名称,需要根据实际情况修改
Set ele1 = ThisDrawing.ModelSpace.Item(i) ' 多段线
get3Dpts = ele1.Coordinates
astr = ""
For j = LBound(get3Dpts, 1) To UBound(get3Dpts, 1) - 1 Step 2
index = index + 1
astr = astr + vbCrLf + FormatNumber(get3Dpts(j), 2, vbFalse, vbFalse, vbFalse) + " " + FormatNumber(get3Dpts(j + 1), 2, vbFalse, vbFalse, vbFalse) + " " + Str(ele1.Elevation)
Next j
Print #1, astr
End If
Next i
Close #1
End Sub

...全文
1502 2 打赏 收藏 转发到动态 举报
写回复
用AI写文章
2 条回复
切换为时间正序
请发表友善的回复…
发表回复
「已注销」 2016-07-28
  • 打赏
  • 举报
回复
顶一个,求助啊 astr = astr + vbCrLf + FormatNumber(get3Dpts(j), 2, vbFalse, vbFalse, vbFalse) + " " + FormatNumber(get3Dpts(j + 1), 2, vbFalse, vbFalse, vbFalse) + " " + Str(ele1.Elevation)改成astr = astr + vbCrLf + FormatNumber(get3Dpts(j), 2, vbFalse, vbFalse, vbFalse) + " " + FormatNumber(get3Dpts(j + 1), 2, vbFalse, vbFalse, vbFalse) + " " + FormatNumber(get3Dpts(j + 2), 2, vbFalse, vbFalse, vbFalse)可以吗?
「已注销」 2016-07-28
  • 打赏
  • 举报
回复
求帮忙。。。

7,763

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧