导入以上的两个类模块后,通过以下程序可以完成你的需要:
- Sub getDistAtPnt()
- '定义引用曲线类模块
- Dim ObjCurve As curve
- Set ObjCurve = New curve
- '获取曲线
- Dim Pnt As Variant
- Dim Ent As AcadEntity
- ThisDrawing.Utility.GetEntity Ent, Pnt, "选择曲线:"
- '保存捕捉模式,并更捕捉模式为最近点捕捉
- Dim SelectMode As Integer
- SelectMode = ThisDrawing.GetVariable("OSMODE")
- ThisDrawing.SetVariable "OSMODE", 512
- '亮显刚选定的曲线以方便捕捉曲线上的点
- Ent.Highlight True
- '捕捉曲线上的一个点
- Pnt = ThisDrawing.Utility.GetPoint(, "选择曲线上的一点:")
- '将捕捉模式恢复原先状态
- ThisDrawing.SetVariable "OSMODE", SelectMode
- '通过曲线类模块计算曲线长度
- Set ObjCurve.Entity = Ent
- Dim Dist As Double
- Dist = ObjCurve.GetDistanceAtPoint(Pnt)
- '显示曲线长度
- MsgBox "曲线上一点到曲线起点的长度为" & vbCrLf & vbCrLf & Dist, , "明经通道VBA示例"
- '取消曲线的亮显
- Ent.Highlight False
- '释放变量
- Set ObjCurve = Nothing
- End Sub
|