VLAX类及曲线操作
VLAX类 - VLAX.cls:曲线操作Curve.cls: 可能我没说明白,我是说我已经成功引用了VLAX类及curve类,在计算量较小时运行正常,而假如在一条多义线与n个实体相交有n个交点,我要用getdistanceatpoint来计算交点至多义线起点的长度,得到一个与交点对应的长度数组,当n值达到100以上时,就会出错,请班竹帮忙找找原因,先谢了 通过运行,发现在以下代码运行时不稳定,报错Private Sub Class_Initialize()
If Left(ThisDrawing.Application.Version, 2) = "15" Then
Set VL = ThisDrawing.Application.GetInterfaceObject("VL.Application.1")
Else
Set VL = ThisDrawing.Application.GetInterfaceObject("VL.Application.16")
End If
Set VLF = VL.ActiveDocument.Functions
End Sub
在参考其他源码,发现做如下变动,运行就比较稳定
Private Sub Class_Initialize()
ThisDrawing.SendCommand "(vl-load-com)" & vbCr '首先要加载VL接口,因为后面的函数是基于它的。本句为新添加语句,其他不变
If Left(ThisDrawing.Application.Version, 2) = "15" Then
Set VL = ThisDrawing.Application.GetInterfaceObject("VL.Application.1")
ElseIf Left(ThisDrawing.Application.Version, 2) = "16" Then
Set VL = ThisDrawing.Application.GetInterfaceObject("VL.Application.16")
End If
Set VLF = VL.ActiveDocument.Functions
End Sub
运行环境:XP3,CAD2006,VB6 有没有大神解释下Curve类模块中 GetClosestPointToProjection 的Normal参数在VBA中如何指定啊?
多谢!
Public Function GetClosestPointToProjection(Point As Variant, Normal As Variant, Optional Extend As Boolean = False) As Variant
Dim retval As Variant, pt(0 To 2) As Double
Dim i As Long
With objVLAX
.SetLispSymbol "handle", mvarEntity.Handle
.SetLispSymbol "givenPt", Point
.SetLispSymbol "normal", Normal
If Extend Then .EvalLispExpression "(setq ext T)"
.EvalLispExpression "(setq lst (vlax-curve-getClosestPointToProjection (handent handle) givenPt normal ext))"
retval = .GetLispList("lst")
.NullifySymbol "handle", "lst", "normal", "ext", "givenPt"
End With
For i = 0 To 2
pt(i) = retval(i)
Next
GetClosestPointToProjection = pt
End Function
专家:Curve.cls如何使用,请举GetDistanceAtPoint说明 导入以上的两个类模块后,通过以下程序可以完成你的需要:
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
你太厉害了,这么长的程序都可以编出来,以后请多多指教啊!!! 我想知道GetPointAtDistance函数怎么用。
此外,希望站长能将类的使用方法和步骤介绍一下,我真的有点摸不着头脑。 好程序,没有权利奖励积分,但有权利送花一朵!:)
我vba不熟,不过却看懂了下面几行' VLAX.CLS v2.0 (Last updated 8/1/2003)
' Copyright 1999-2001 by Frank Oquendo
'
' 该程序由乐筑天下修改支持2004版本
' http://www.mjtd.com
'
' 1. VLAX.CLS - This file can be obtained by visiting http://www.acadx.com
在此感谢管理员的辛勤修编工作。
页:
[1]
2