获得多段线分段长度的vba

jicqj

我们知道 对象的长度可以用 object.length 获得，但是对于多段线，只能获得合计的长度，如何显示每段的长度呢。这是我的小程序，希望对大家有帮助。

 

Function PLinelength(ent As AcadEntity) As String
On Error GoTo errHandle
Dim i As Integer
Dim myPointSta As Variant, myPointEnd As Variant
Dim myLength As Double

i = 1
myPointSta = ent.Coordinate(0)

 Do
myPointEnd = ent.Coordinate(i)
myLength = VBA.Sqr((myPointSta(0) - myPointEnd(0)) ^ 2 + (myPointSta(1) - myPointEnd(1)) ^ 2)

 

myPointSta = myPointEnd
PLinelength = IIf(PLinelength = "", myLength, PLinelength & "+" & myLength)
i = i + 1
Loop Until Err

errHandle:

End Function

 

Sub 测试程序()

'////////////////////////////////////////////////
    Dim ssetObj As AcadSelectionSet
     Dim tCONUT As Integer
    tCONUT = 0
    tCONUT = ThisDrawing.SelectionSets.Count
     For ti = 0 To tCONUT - 1 '删除所有的选择集
    Set ssetObj = ThisDrawing.SelectionSets.Item(0)
      ssetObj.Delete
    Next ti

'//////////////////////////////////////////////////
Set sel = ThisDrawing.SelectionSets.Add("ssel") 

If Err Then
Err.Clear
Set sel = ThisDrawing.SelectionSets.Item("ssel")

End If

Lab_star:

sel.SelectOnScreen

Dim ent As AcadEntity

For Each ent In sel

MsgBox PLinelength(ent)
Next ent

End Sub

 

jdzhqddzh

有圆弧段的结果不正确。

jicqj

自己顶一下

hhh454

顶起来，我也不太会

xinght99

好的兄弟，有志气

hhh454

我想要一个lisp的获得多段线的分段长度

cuyongping

我也想要一个lisp的获得多段线的分段长度！呵呵希望有人提供！

yshf

有圆弧段的结果不正确。

jicqj

yshf 发表于 2011-11-11 20:44
有圆弧段的结果不正确。

看来算法要改进 你有什么好办法

yshf

当多段线中有某段为圆弧时，其凸度（弓高/半弦长）不为零，由此可得到半径、圆心角，也就能得到该段的长度。

随风缘

先学习一下