求曲线等分点或等线段点的坐标

求曲线等分点或等线段点的坐标

部分关键代码如下:

 '对选定曲线进行等分（总点数）Dim clsClip As New dClipBordDim dSet As AcadSelectionSetDim clsSet As New dSelectionSetDim clsEnt As New dEntityDim Ent As AcadEntity '对象Dim dCount As Long '段数，运行之后就明确了Dim dObj As Object '绘出的新对象Dim PointX() As Double, PointY() As Double, PointZ() As DoubleDim dStr As String '用于存放坐标字串:dStr = ""Dim dTimes As LongDim TempStr As StringDim clsStr As New dStringDim F() As DoubleDim startTan(0 To 2) As Double: startTan(0) = 0: startTan(1) = 0: startTan(2) = 0:Dim endTan(0 To 2) As Double: endTan(0) = 0: endTan(1) = 0: endTan(2) = 0Dim clsMath As New dMathdCount = UserForm1.TextBox5clsSet.CreateSelectionCurveSet dSet '选取曲线对象If dSet.Count = 0 Then Exit SubFor Each Ent In dSetdTimes = dTimes + 1'dStr = vbCrclsEnt.EntItoXYZ Ent, dCount, PointX, PointY, PointZ'根据类型作曲线Select Case Ent.ObjectNameCase "AcDb3dPolyline"  '如是三维多线段clsMath.P3DtoPoint PointX, PointY, PointZ, F, 0clsStr.XYZtoStr PointX, PointY, PointZ, TempStrSet dObj = ThisDrawing.ModelSpace.Add3DPoly(F)Case "AcDbSpline"      '如果是样条曲线clsMath.P3DtoPoint PointX, PointY, PointZ, F, 0clsStr.XYZtoStr PointX, PointY, PointZ, TempStrSet dObj = ThisDrawing.ModelSpace.AddSpline(F, startTan, endTan)Case "AcDb2dPolyline"       '如是二维多线段clsMath.P3DtoPoint PointX, PointY, PointZ, F, 0Set dObj = ThisDrawing.ModelSpace.AddPolyline(F)clsEnt.SetHeight dObj, PointZ(0)clsStr.XYtoStr PointX, PointY, TempStrCase Else '其余全按多线段进行处理clsMath.P2DtoPoint PointX, PointY, F, 0Set dObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(F())clsEnt.SetHeight dObj, PointZ(0)clsStr.XYtoStr PointX, PointY, TempStrEnd SelectclsEnt.EqualFormat Ent, dObjEnt.DeletedStr = dStr + TempStr + vbCr + "" + vbCrNext Ent'去掉最后一个回车符dStr = Left(dStr, Len(dStr) - 1)clsClip.PutClipBord dStr