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

yicol 发表于 2003-6-12 21:55:00

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

贴出我的源程序

Sub Count_len()
' 创建新的选择集
Dim sset As AcadSelectionSet

For i = 0 To ThisDrawing.SelectionSets.Count - 1
ThisDrawing.SelectionSets.Item(i).Clear
ThisDrawing.SelectionSets.Item(i).Delete
Next
On Error Resume Next
Set sset = ThisDrawing.SelectionSets.Add("SS0")
sset.SelectOnScreen
Dim entry As AcadEntity
Dim l_text As String
Dim l_l As Double
Dim Arc_count As Integer
Dim Line_count As Integer
For Each entry In sset
   '如果是多段线或曲线的长度，就不行了
   If entry.ObjectName = "AcDbArc" Then
   l_text = l_text & "+" & entry.ArcLength
   l_l = l_l + entry.ArcLength
   Arc_count = Arc_count + 1
   ElseIf entry.ObjectName = "AcDbLine" Then
   l_text = l_text & "+" & entry.Length
   l_l = l_l + entry.Length
   Line_count = Line_count + 1
   End If
Next entry

ThisDrawing.Utility.Prompt vbCrLf & Arc_count & "个弧," & Line_count & "条直线. 共" & Arc_count + Line_count & "个对象." & vbCrLf & l_text & "=" & l_l & vbCrLf
End Sub

mccad 发表于 2003-6-12 20:31:00

必须结合VLAX类开处理，实用函数栏目中有相关的函数

yicol 发表于 2003-6-12 21:58:00

劳烦版主把我上面的程序改改

谢谢

xuehua4888 发表于 2003-7-10 01:00:00

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

mccad 发表于 2003-7-10 06:57:00

导入vlax.cls类后，在thisdrawing模块中输入以下代码，运行则可：
Sub GetLength()
Dim obj As AcadEntity
Dim pnt As Variant
ThisDrawing.Utility.GetEntity obj, pnt, "选取曲线："
Dim leng As Double
leng = GetCurveLength(obj)
MsgBox "所选曲线的长度为 " & leng, , "明经通道VBA示例"
End Sub

Public Function GetCurveLength(curve As AcadEntity) As Double

Dim obj As VLAX, retVal

Set obj = New VLAX
obj.EvalLispExpression "(setq curve (handent " & Chr(34) & curve.Handle & Chr(34) & "))"
obj.EvalLispExpression "(setq curvelength (vlax-curve-getDistAtParam curve " & _
"(vlax-curve-getEndParam curve)))"
retVal = obj.GetLispSymbol("curvelength")
obj.NullifySymbol "curve", "curvelength"
Set obj = Nothing
GetCurveLength = CDbl(retVal)

End Function

gzy 发表于 2003-9-22 22:27:00

可一先分解再获得嘛

页: [1]

明经CAD社区's Archiver