[求助]：怎样在曲线的给定长度位置做标记

earchen

cad有一个divide命令，可以在曲线（直线，多义线，圆弧凳）的等分点处绘制一个标记点或插入一个块儿。那么在vba程序中怎样实现这一功能呢?   还有，如果我想在曲线上一个给定长度的位置作一个标记，应该怎么样实现，也就是怎样来获取曲线上给定长度位置处的点的坐标。

这是一个在道路和水利上很有用的功能，可以在指定的轴线上自动生成具有一定间隔的桩点

wfgjy

道路上这样是不行的，必须用连续桩点

13607219756

公路里程桩号也是这样标注的，我也想要这方面的东东！

efan2000

求曲线上一定参数的点，参数是VL的叫法，它将一条曲线分为0-1的参数，0为起点，1为终点，也就是将曲线等分为多少份的意思。

具体例子如下：

2. 
   
3.   [FONT=courier new]
   
4. Private Function GetPointAtParam(ByVal EntObj As AcadEntity, ByVal Param As Double) As Variant
   
5.     Dim VL As Object
   
6.     Dim VLF As Object
   
7.    
   
8.     Dim sym As Object
   
9.     Dim ret As Variant
   
10.     Dim list As Object
    
11.     Dim n As Integer
    
12.     Dim i As Integer
    
13.     Dim Count As Integer
    
14.     Dim elements() As Variant
    
15.    
    
16.     ThisDrawing.SendCommand "(vl-load-com)" & vbCr '首先要加载VL接口，因为后面的函数是基于它的。
    
17.    
    
18.     Set VL = Application.GetInterfaceObject("VL.Application.16") '这是用于R2004版的，R2000或者R2002的应该使用VL.Application.1。
    
19.     Set VLF = VL.ActiveDocument.Functions
    
20.     Set sym = VLF.Item("read").funcall("handle") '传入句柄
    
21.     ret = VLF.Item("set").funcall(sym, EntObj.Handle)
    
22.     Set sym = VLF.Item("read").funcall("(setq curve (handent handle))") '根据句柄得到实体名称（Lisp中的实体名称，这和EntityName是不一样的。）
    
23.     Set ret = VLF.Item("eval").funcall(sym)
    
24.     Set sym = VLF.Item("read").funcall("param") '传入参数
    
25.     ret = VLF.Item("set").funcall(sym, Param)
    
26.     Set sym = VLF.Item("read").funcall("(setq lst (vlax-curve-getPointAtParam curve (* param (vlax-curve-getEndParam curve))))") '计算点。
    
27.     Set list = VLF.Item("eval").funcall(sym)
    
28.     Count = VLF.Item("length").funcall(list) '返回点的数组长度
    
29.     ReDim elements(0 To Count - 1) As Variant
    
30.     For i = 0 To Count - 1
    
31.         elements(i) = VLF.Item("nth").funcall(i, list) '取点的坐标
    
32.     Next
    
33.     GetPointAtParam = elements
    
34. End Function
    
35. 
    
36. Sub test()
    
37.     Dim Pt As Variant
    
38.     Pt = GetPointAtParam(ThisDrawing.ModelSpace(1), 0.5)
    
39. 
    
40.     Debug.Print "曲线中点坐标: " & Pt(0) & "," & Pt(1)
    
41. End Sub
    
42.   [/FONT]
    

<br />   [FONT=courier new]<br /> Private Function GetPointAtParam(ByVal EntObj As AcadEntity, ByVal Param As Double) As Variant<br />     Dim VL As Object<br />     Dim VLF As Object<br />     <br />     Dim sym As Object<br />     Dim ret As Variant<br />     Dim list As Object<br />     Dim n As Integer<br />     Dim i As Integer<br />     Dim Count As Integer<br />     Dim elements() As Variant<br />     <br />     ThisDrawing.SendCommand "(vl-load-com)" & vbCr '首先要加载VL接口，因为后面的函数是基于它的。<br />     <br />     Set VL = Application.GetInterfaceObject("VL.Application.16") '这是用于R2004版的，R2000或者R2002的应该使用VL.Application.1。<br />     Set VLF = VL.ActiveDocument.Functions<br />     Set sym = VLF.Item("read").funcall("handle") '传入句柄<br />     ret = VLF.Item("set").funcall(sym, EntObj.Handle)<br />     Set sym = VLF.Item("read").funcall("(setq curve (handent handle))") '根据句柄得到实体名称（Lisp中的实体名称，这和EntityName是不一样的。）<br />     Set ret = VLF.Item("eval").funcall(sym)<br />     Set sym = VLF.Item("read").funcall("param") '传入参数<br />     ret = VLF.Item("set").funcall(sym, Param)<br />     Set sym = VLF.Item("read").funcall("(setq lst (vlax-curve-getPointAtParam curve (* param (vlax-curve-getEndParam curve))))") '计算点。<br />     Set list = VLF.Item("eval").funcall(sym)<br />     Count = VLF.Item("length").funcall(list) '返回点的数组长度<br />     ReDim elements(0 To Count - 1) As Variant<br />     For i = 0 To Count - 1<br />         elements(i) = VLF.Item("nth").funcall(i, list) '取点的坐标<br />     Next<br />     GetPointAtParam = elements<br /> End Function<br /> <br /> Sub test()<br />     Dim Pt As Variant<br />     Pt = GetPointAtParam(ThisDrawing.ModelSpace(1), 0.5) <br /> <br />     Debug.Print "曲线中点坐标: " & Pt(0) & "," & Pt(1)<br /> End Sub<br />   [/FONT]<br />

earchen

多谢各位，在R14下面怎样运行“vl-load-com”，我的程序需要在r14下面运行哦

efan2000

R14好象没有附带Visual Lisp吧，如果没有的话可能只有在ARX中实现了。

earchen

啊！这样啊，5555......

gyl

在执行语句“Set list = VLF.Item("eval").funcall(sym)”时，出一个“要求对象”的错误。

efan2000

已经修改，原来的多了一句Set sym = VLF.Item("read").funcall("lst")。后来发现在圆弧下取参数为0时会产生错误，而其它曲线则不会。
还有函数中的起点参数应该为0，而终点参数并不是为1，因而将传入的参数作为一个系数来看待，它的取值应该是0-1之间。

lsjjm

使用VLISP吧!
(vlax-curve-getpointatdist obj dist)

gyl

最初由 efan2000 发布
[B]还有函数中的起点参数应该为0，而终点参数并不是为1，因而将传入的参数作为一个... [/B]

还是有些不明白：终点参数并不为1，应该是多少？如果我想取得曲线上距离端点20个单位长度的点的坐标，参数应该设为多少？

lsjjm

最初由 gyl 发布
还是有些不明白：终点参数并不为1，应该是多少？如果我想取得曲线上距离端... [/B]

(setq pt (vlax-curve-getPointatdist curveobj 20.0))

gyl

最初由 lsjjm 发布
[B]
(setq pt (vlax-curve-getPointatdist curveobj 20.0)) [/B]

我不懂VLISP，想向你问一下。但你的悄悄话收件箱满了。

lsjjm

对不起, 我才把收件箱清理了. 有什么问题? 请问.  咱们一起讨论研究! 不会再请教别人!

gyl

你的收件箱并没有清理，还是发不进去。
我想请帮忙看一下这个帖子：
http://www.xdcad.net/forum/showthread.php?s=&threadid=91116
我的MSN: gongyouliang@hotmail.com