社区 › VBA/VB/ActiveX/API 编程技术 › 如何计算指定线加总长度？

supercorn 发表于 2004-9-23 11:29:00

如何计算指定线加总长度？

如何计算指定线加总长度？



可以选定N条线（直线、曲线、多线段、圆弧......），然后计算它们的长度和。

雪山飞狐_lzh 发表于 2004-9-23 11:33:00

看看置顶的Vlax类

o_o 发表于 2004-9-23 17:32:00

工具－查询－列表显示


可以显示每条线的长度

zxli2004 发表于 2004-10-29 21:33:00

顶一下，VBA怎么实现？

dchlmz 发表于 2004-10-30 09:49:00

直线可以用length取得，其它通过取得坐标计算线长，累加就行了

zxli2004 发表于 2004-10-30 11:03:00

这样是不是对spline的精度偏差较大？


length只能对Line和Arc有效。

zxli2004 发表于 2004-10-30 17:13:00

急，我再顶！

mccad 发表于 2004-10-30 20:59:00

Sub GetSelectCurveLength()
       Dim SS As AcadSelectionSet
       Set SS = CreateSelectionSet
       Dim varType As Variant
       Dim varData As Variant
       BuildFilter varType, varData, 0, _
                           "ARC,CIRCLE,ELLIPSE,LINE,LWPOLYLINE,POLYLINE,SPLINE"
       SS.SelectOnScreen varType, varData
       Dim objEntity As AcadEntity
       Dim dblLength As Double
       For Each objEntity In SS
               dblLength = dblLength + GetCurveLength(objEntity)
       Next
       MsgBox "所选曲线的总长度为 " & dblLength, , "明经通道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
Public Sub BuildFilter(typeArray, dataArray, ParamArray gCodes())
       Dim fType() As Integer, fData()
       Dim index As Long, i As Long
      
       index = LBound(gCodes) - 1
               
       For i = LBound(gCodes) To UBound(gCodes) Step 2
               index = index + 1
               ReDim Preserve fType(0 To index)
               ReDim Preserve fData(0 To index)
               fType(index) = CInt(gCodes(i))
               fData(index) = gCodes(i + 1)
       Next
       typeArray = fType: dataArray = fData
End Sub
Function CreateSelectionSet(Optional SSetName As String = "mjtd") As AcadSelectionSet
       On Error Resume Next
       ThisDrawing.SelectionSets(SSetName).Delete
       Set CreateSelectionSet = ThisDrawing.SelectionSets.Add(SSetName)
End Function

zxli2004 发表于 2004-10-31 11:56:00

Dim obj As VLAX, retVal<BR>                       <BR>                       Set obj = New VLAX<BR>？？？？？？？？？？？？是不是少东西？


我不太懂，请多指教。谢谢!!

mccad 发表于 2004-10-31 12:12:00

二楼不是已经说过了，用VLAX类，请查看置顶贴子。

查看完整版本: 如何计算指定线加总长度？