算法讨论

mikewolf2k

如题，对于一段任意曲线，如何能得到从起点开始，每隔一定距离的点的坐标？

或者其中一个特例，全部是直线的曲线，每隔一定距离的点的坐标。

大家有什么思路，请提示一下，谢谢。

gyl

在VisualLISP中有专门的函数，在VBA中实现很困难

mikewolf2k

可惜我不会lisp，只能用vba。

mccad

2. Sub Measure()
3.     Dim Ent As AcadEntity
4.     Dim Pnt As Variant
5.     ThisDrawing.Utility.GetEntity Ent, Pnt, vbCr & "请选择要按距离取点的曲线:"
6.     Ent.Highlight True
7.     Dim Dis As Double
8.     Dis = ThisDrawing.Utility.GetDistance(, vbCr & "选择长度：")
9.     Dim Cnt As Long
10.     Cnt = ThisDrawing.ModelSpace.Count
11.     ThisDrawing.SendCommand "measure" & vbCr & _
12.                GetDoubleEntTable(Ent, Pnt) & vbCr & Dis & vbCr
13.     Dim i As Long
14.     Dim Point As AcadPoint
15.     Dim PntPos As Variant
16.     For i = ThisDrawing.ModelSpace.Count - 1 To Cnt Step -1
17.         If ThisDrawing.ModelSpace(i).ObjectName = "AcDbPoint" Then
18.             Debug.Print ThisDrawing.ModelSpace(i).ObjectName
19.             Set Point = ThisDrawing.ModelSpace(i)
20.             PntPos = Point.Coordinates
21.             Debug.Print PntPos(0) & "  " & PntPos(1)
22.             Point.Delete
23.         End If
24.     Next
25. End Sub
26. '转换双元表的函数
27. Public Function GetDoubleEntTable(entObj As AcadEntity, Pnt As Variant) As String
28.     Dim entHandle As String
29.     entHandle = entObj.Handle
30.     GetDoubleEntTable = "(list(handent " & Chr(34) & entHandle & Chr(34) & _
31.                      ")(list " & Str(Pnt(0)) & Str(Pnt(1)) & Str(Pnt(2)) & "))"
32. End Function

Sub Measure()     Dim Ent As AcadEntity     Dim Pnt As Variant     ThisDrawing.Utility.GetEntity Ent, Pnt, vbCr & "请选择要按距离取点的曲线:"     Ent.Highlight True     Dim Dis As Double     Dis = ThisDrawing.Utility.GetDistance(, vbCr & "选择长度：")     Dim Cnt As Long     Cnt = ThisDrawing.ModelSpace.Count     ThisDrawing.SendCommand "measure" & vbCr & _                GetDoubleEntTable(Ent, Pnt) & vbCr & Dis & vbCr     Dim i As Long     Dim Point As AcadPoint     Dim PntPos As Variant     For i = ThisDrawing.ModelSpace.Count - 1 To Cnt Step -1         If ThisDrawing.ModelSpace(i).ObjectName = "AcDbPoint" Then             Debug.Print ThisDrawing.ModelSpace(i).ObjectName             Set Point = ThisDrawing.ModelSpace(i)             PntPos = Point.Coordinates             Debug.Print PntPos(0) & "  " & PntPos(1)             Point.Delete         End If     Next End Sub '转换双元表的函数 Public Function GetDoubleEntTable(entObj As AcadEntity, Pnt As Variant) As String     Dim entHandle As String     entHandle = entObj.Handle     GetDoubleEntTable = "(list(handent " & Chr(34) & entHandle & Chr(34) & _                      ")(list " & Str(Pnt(0)) & Str(Pnt(1)) & Str(Pnt(2)) & "))" End Function

wmz

请教Mccad,如何取得样条曲线上各节点的坐标?用vla-get-ControlPoints Object函数只能取得样条曲线上的控制点坐标.