问了几次了，多段线的长度怎么获得

yicol

劳烦版主回答了几次，
但我运行时却报错呀

贴出我的源程序

2. Sub Count_len()
   
3.     ' 创建新的选择集
   
4.     Dim sset As AcadSelectionSet
   
5. 
   
6. For i = 0 To ThisDrawing.SelectionSets.Count - 1
   
7. ThisDrawing.SelectionSets.Item(i).Clear
   
8. ThisDrawing.SelectionSets.Item(i).Delete
   
9. Next
   
10. On Error Resume Next
    
11.     Set sset = ThisDrawing.SelectionSets.Add("SS0")
    
12.    sset.SelectOnScreen
    
13.      Dim entry As AcadEntity
    
14.     Dim l_text As String
    
15.     Dim l_l As Double
    
16.     Dim Arc_count As Integer
    
17.     Dim Line_count As Integer
    
18.     For Each entry In sset
    
19.         '如果是多段线或曲线的长度，就不行了
    
20.         If entry.ObjectName = "AcDbArc" Then
    
21.         l_text = l_text & "+" & entry.ArcLength
    
22.         l_l = l_l + entry.ArcLength
    
23.         Arc_count = Arc_count + 1
    
24.         ElseIf entry.ObjectName = "AcDbLine" Then
    
25.         l_text = l_text & "+" & entry.Length
    
26.         l_l = l_l + entry.Length
    
27.         Line_count = Line_count + 1
    
28.         End If
    
29.     Next entry
    
30. 
    
31. ThisDrawing.Utility.Prompt vbCrLf & Arc_count & "个弧," & Line_count & "条直线. 共" & Arc_count + Line_count & "个对象." & vbCrLf & l_text & "=" & l_l & vbCrLf
    
32. End Sub

Sub Count_len()<br />     ' 创建新的选择集<br />     Dim sset As AcadSelectionSet<br /> <br /> For i = 0 To ThisDrawing.SelectionSets.Count - 1<br /> ThisDrawing.SelectionSets.Item(i).Clear<br /> ThisDrawing.SelectionSets.Item(i).Delete<br /> Next<br /> On Error Resume Next<br />     Set sset = ThisDrawing.SelectionSets.Add("SS0")<br />    sset.SelectOnScreen<br />      Dim entry As AcadEntity<br />     Dim l_text As String<br />     Dim l_l As Double<br />     Dim Arc_count As Integer<br />     Dim Line_count As Integer<br />     For Each entry In sset<br />         '如果是多段线或曲线的长度，就不行了<br />         If entry.ObjectName = "AcDbArc" Then<br />         l_text = l_text & "+" & entry.ArcLength<br />         l_l = l_l + entry.ArcLength<br />         Arc_count = Arc_count + 1<br />         ElseIf entry.ObjectName = "AcDbLine" Then<br />         l_text = l_text & "+" & entry.Length<br />         l_l = l_l + entry.Length<br />         Line_count = Line_count + 1<br />         End If<br />     Next entry<br /> <br /> ThisDrawing.Utility.Prompt vbCrLf & Arc_count & "个弧," & Line_count & "条直线. 共" & Arc_count + Line_count & "个对象." & vbCrLf & l_text & "=" & l_l & vbCrLf<br /> End Sub

mccad

yicol

谢谢

xuehua4888

用2004吧，里面可以直接调用pline的length属性。

mccad

导入vlax.cls类后，在thisdrawing模块中输入以下代码，运行则可：

2. Sub GetLength()
   
3.     Dim obj As AcadEntity
   
4.     Dim pnt As Variant
   
5.     ThisDrawing.Utility.GetEntity obj, pnt, "选取曲线："
   
6.     Dim leng As Double
   
7.     leng = GetCurveLength(obj)
   
8.     MsgBox "所选曲线的长度为 " & leng, , "明经通道VBA示例"
   
9. End Sub
   
10. 
    
11. Public Function GetCurveLength(curve As AcadEntity) As Double
    
12. 
    
13.     Dim obj As VLAX, retVal
    
14.    
    
15.     Set obj = New VLAX
    
16.     obj.EvalLispExpression "(setq curve (handent " & Chr(34) & curve.Handle & Chr(34) & "))"
    
17.     obj.EvalLispExpression "(setq curvelength (vlax-curve-getDistAtParam curve " & _
    
18.                            "(vlax-curve-getEndParam curve)))"
    
19.     retVal = obj.GetLispSymbol("curvelength")
    
20.     obj.NullifySymbol "curve", "curvelength"
    
21.     Set obj = Nothing
    
22.     GetCurveLength = CDbl(retVal)
    
23. 
    
24. End Function

Sub GetLength()<br />     Dim obj As AcadEntity<br />     Dim pnt As Variant<br />     ThisDrawing.Utility.GetEntity obj, pnt, "选取曲线："<br />     Dim leng As Double<br />     leng = GetCurveLength(obj)<br />     MsgBox "所选曲线的长度为 " & leng, , "明经通道VBA示例"<br /> End Sub<br /> <br /> Public Function GetCurveLength(curve As AcadEntity) As Double<br /> <br />     Dim obj As VLAX, retVal<br />     <br />     Set obj = New VLAX<br />     obj.EvalLispExpression "(setq curve (handent " & Chr(34) & curve.Handle & Chr(34) & "))"<br />     obj.EvalLispExpression "(setq curvelength (vlax-curve-getDistAtParam curve " & _<br />                            "(vlax-curve-getEndParam curve)))"<br />     retVal = obj.GetLispSymbol("curvelength")<br />     obj.NullifySymbol "curve", "curvelength"<br />     Set obj = Nothing<br />     GetCurveLength = CDbl(retVal)<br /> <br /> End Function

gzy

可一先分解再获得嘛