明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 44654|回复: 76

VLAX类及曲线操作

  [复制链接]
发表于 2003-8-7 22:23:00 | 显示全部楼层 |阅读模式
本帖最后由 作者 于 2003-10-3 13:56:14 编辑

VLAX类 - VLAX.cls:

曲线操作Curve.cls:

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 2威望 +5 金钱 +2 贡献 +1 激情 +2 收起 理由
兰州人 + 4 【好评】 版主不愧是高手
efan2000 + 1 + 2 + 1 + 2 【好评】好文章

查看全部评分

发表于 2005-2-22 10:34:00 | 显示全部楼层
可能我没说明白,我是说我已经成功引用了VLAX类及curve类,在计算量较小时运行正常,而假如在一条多义线与n个实体相交有n个交点,我要用getdistanceatpoint来计算交点至多义线起点的长度,得到一个与交点对应的长度数组,当n值达到100以上时,就会出错,请班竹帮忙找找原因,先谢了
发表于 2015-11-4 12:12:51 | 显示全部楼层
通过运行,发现在以下代码运行时不稳定,报错
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
回复 支持 1 反对 0

使用道具 举报

发表于 2021-6-15 22:48:40 | 显示全部楼层
有没有大神解释下  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
发表于 2003-9-12 13:24:00 | 显示全部楼层
专家:Curve.cls如何使用,请举GetDistanceAtPoint说明
 楼主| 发表于 2003-9-12 19:59:00 | 显示全部楼层
导入以上的两个类模块后,通过以下程序可以完成你的需要:
  1. Sub getDistAtPnt()
  2.     '定义引用曲线类模块
  3.     Dim ObjCurve As curve
  4.     Set ObjCurve = New curve
  5.     '获取曲线
  6.     Dim Pnt As Variant
  7.     Dim Ent As AcadEntity
  8.     ThisDrawing.Utility.GetEntity Ent, Pnt, "选择曲线:"
  9.     '保存捕捉模式,并更捕捉模式为最近点捕捉
  10.     Dim SelectMode As Integer
  11.     SelectMode = ThisDrawing.GetVariable("OSMODE")
  12.     ThisDrawing.SetVariable "OSMODE", 512
  13.     '亮显刚选定的曲线以方便捕捉曲线上的点
  14.     Ent.Highlight True
  15.     '捕捉曲线上的一个点
  16.     Pnt = ThisDrawing.Utility.GetPoint(, "选择曲线上的一点:")
  17.     '将捕捉模式恢复原先状态
  18.     ThisDrawing.SetVariable "OSMODE", SelectMode
  19.     '通过曲线类模块计算曲线长度
  20.     Set ObjCurve.Entity = Ent
  21.     Dim Dist As Double
  22.     Dist = ObjCurve.GetDistanceAtPoint(Pnt)
  23.     '显示曲线长度
  24.     MsgBox "曲线上一点到曲线起点的长度为" & vbCrLf & vbCrLf & Dist, , "明经通道VBA示例"
  25.     '取消曲线的亮显
  26.     Ent.Highlight False
  27.     '释放变量
  28.     Set ObjCurve = Nothing
  29. End Sub
发表于 2003-10-2 08:21:00 | 显示全部楼层
你太厉害了,这么长的程序都可以编出来,以后请多多指教啊!!!
发表于 2003-10-9 01:02:00 | 显示全部楼层
我想知道GetPointAtDistance函数怎么用。
此外,希望站长能将类的使用方法和步骤介绍一下,我真的有点摸不着头脑。
发表于 2004-1-7 23:46:00 | 显示全部楼层
好程序,没有权利奖励积分,但有权利送花一朵!:)
发表于 2004-1-26 13:53:00 | 显示全部楼层
郑志伟发表于2003-10-2 8:21:00你太厉害了,这么长的程序都可以编出来,以后请多多指教啊!!!

我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 在此感谢管理员的辛勤修编工作。
发表于 2004-2-2 12:00:00 | 显示全部楼层
能否编一个函数实现如下功能:已知曲线上的某点,求在曲线上到此点指定距离的另一点.
发表于 2004-3-12 17:18:00 | 显示全部楼层
我想下载“VLAX类及曲线操作”却出现HTTP 500 - 内部服务器错误,怎样才能下载下来?
发表于 2004-3-12 17:47:00 | 显示全部楼层
链接已经失效了,你可以复制后保存为CLS文件啊

评分

参与人数 1威望 +2 收起 理由
兰州人 + 2 【好评】 高手就是高手

查看全部评分

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-16 17:57 , Processed in 0.201859 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表