[编程申请]：请教版主

earchen

怎样用vba计算一条曲线（直线，圆弧，pline线等）的长度，我想知道是怎样的算法和函数

efan2000

VLAX类函数是完整的处理曲线的函数，现只提取出求曲线长度的算法。

2. 
   
3.   [FONT=courier new]
   
4. Private Function GetLength(ByVal EntObj As AcadEntity) As Variant
   
5.     Dim VL As Object
   
6.     Dim VLF As Object
   
7.    
   
8.     Dim sym As Object
   
9.     Dim ret As Variant
   
10.    
    
11.     ThisDrawing.SendCommand "(vl-load-com)" & vbCr ‘首先要加载VL接口，因为后面的函数是基于它的。
    
12.    
    
13.     Set VL = Application.GetInterfaceObject("VL.Application.16") '这是用于R2004版的，R2000或者R2002的应该使用VL.Application.1。
    
14.     Set VLF = VL.ActiveDocument.Functions
    
15.     Set sym = VLF.Item("read").funcall("handle") '传入句柄
    
16.     ret = VLF.Item("set").funcall(sym, EntObj.Handle)
    
17.     Set sym = VLF.Item("read").funcall("(setq curve (handent handle))") '根据句柄得到实体名称（Lisp中的实体名称，这和EntityName是不一样的。）
    
18.     Set ret = VLF.Item("eval").funcall(sym)
    
19.     Set sym = VLF.Item("read").funcall("(vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve))") '计算终点参数，然后计算距离。
    
20.     ret = VLF.Item("eval").funcall(sym) '返回长度
    
21.     GetLength = ret
    
22. End Function
    
23. 
    
24. Sub test()
    
25.     Dim l As Double
    
26.     l = GetLength(ThisDrawing.ModelSpace(0))
    
27.     Debug.Print "曲线长度: " & l
    
28. End Sub
    
29.   [/FONT]
    

<br />   [FONT=courier new]<br /> Private Function GetLength(ByVal EntObj As AcadEntity) As Variant<br />     Dim VL As Object<br />     Dim VLF As Object<br />     <br />     Dim sym As Object<br />     Dim ret 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("(vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve))") '计算终点参数，然后计算距离。<br />     ret = VLF.Item("eval").funcall(sym) '返回长度<br />     GetLength = ret<br /> End Function<br /> <br /> Sub test()<br />     Dim l As Double<br />     l = GetLength(ThisDrawing.ModelSpace(0))<br />     Debug.Print "曲线长度: " & l<br /> End Sub<br />   [/FONT]<br />

zhengqg

斑竹真是太高深了!