高手看看，哪里的问题？

yydpj

Public Sub P_Length()
  Dim acadObj As Object
  Dim pline As AcadPolyline
  Dim plineCopy As AcadPolyline
  Dim explodedObjects As Variant
  Dim lineObj As AcadLine
  Dim length, length_Object As Double
  length = 0#
  length_Object = 0#
  For Each acadObj In ThisDrawing.ModelSpace
    If acadObj.ObjectName = "AcDb2dPolyline" Then
     'If acadObj.ObjectName = "AcDbPolyline" Then
        Set pline = acadObj
        Set plineCopy = pline.Copy()
        explodedObjects = plineCopy.Explode
        Dim i As Integer
        For i = 0 To UBound(explodedObjects)
          Set lineObj = explodedObjects(i)
          length = length + lineObj.length
          length_Object = length_Object + lineObj.length
          explodedObjects(i).Delete
        Next
        ThisDrawing.Utility.Prompt "长度="& CStr(length_Object) & (Chr(13) & Chr(10))
        plinecoye.Delete
     End If
     length_Object = 0#
  Next acadObj
  ThisDrawing.Utility.Prompt  "总长度="& CStr(length)
End Sub

问题： If acadObj.ObjectName = "AcDb2dPolyline" Then  '使用此判断，判断结果一直为false
           If acadObj.ObjectName = "AcDbPolyline" Then   '使用此判断，判断结果为真，但
            Set pline = acadObj    '运行时出现，类型不匹配

以上代码，我是直接从书本中COPY来的。

不知道如何修改才能运行正常。

希望各位大侠帮忙。本人刚开始学这个！

谢谢谢谢谢谢了~

yydpj

没人回答么？

雪山飞狐_lzh

声明为Dim pline As AcadLWPolyline，其他做相应的改动

fjfhgdwfn

Public Sub P_Length()
  Dim acadObj As Object
  Dim pline As AcadLWPolyline
  Dim plineCopy As AcadLWPolyline
  Dim aa As AcadLWPolyline
  Dim explodedObjects As Variant
  Dim lineObj As AcadLine
  Dim length, length_Object As Double
  length = 0#
  length_Object = 0#
  For Each acadObj In ThisDrawing.ModelSpace
 
    If acadObj.ObjectName = "AcDbPolyline" Then
     'If acadObj.ObjectName = "AcDbPolyline" Then
        Set pline = acadObj
        Set plineCopy = pline.Copy()
        explodedObjects = plineCopy.Explode
        plineCopy.Delete

        Dim i As Integer
        For i = 0 To UBound(explodedObjects)
          Set lineObj = explodedObjects(i)
          length = length + lineObj.length
          length_Object = length_Object + lineObj.length
          explodedObjects(i).Delete
        Next
        ThisDrawing.Utility.Prompt "长度=" & CStr(length_Object) & (Chr(13) & Chr(10))
      
     End If
     length_Object = 0#
  Next acadObj
  ThisDrawing.Utility.Prompt "总长度=" & CStr(length)
End Sub

你的plineCopy.Delete也写错了。

yydpj

可以了/

谢谢谢谢，万分感谢中

yydpj

又一个问题

想将程序改成，当前模型空间内选中的多段线的总长度，怎么更改一下？

For Each acadObj In ThisDrawing.ModelSpace  '

改成   For Each acadObj In ThisDrawing.SelectionSets 好象根本不对

新手新手，问题有点幼稚，不要笑话~~~

雪山飞狐_lzh

For Each acadObj In ThisDrawing.PickfirstSelectionSet

不过用前看看置顶的“先选择后执行”的帖子

yydpj

谢谢~~~~

OK了

yydpj

Public Sub P_Length()
  Dim acadObj As Object
  Dim pline As AcadLWPolyline
  Dim plineCopy As AcadLWPolyline '优化多段线对象
  Dim explodedObjects As Variant '分解优化多段线，分解成多条直线
  Dim lineObj As AcadLine '直线对象
  Dim arcObj As AcadArc   '圆弧对象
  Dim length, length_Object As Double
  length = 0#
  length_Object = 0#
  Dim ObjName As String
  'For Each acadObj In ThisDrawing.ModelSpace
  For Each acadObj In ThisDrawing.PickfirstSelectionSet  '获取选择优先的选择集
     ObjName = acadObj.ObjectName   '新增，获取选中的对象的名称
     Select Case ObjName
     Case "AcDbPolyline"          '情况1，对象为多段线 。原始代码
        Set pline = acadObj
        Set plineCopy = pline.Copy()
        explodedObjects = plineCopy.Explode
        plineCopy.Delete
        Dim i As Integer
        For i = 0 To UBound(explodedObjects)
          Set lineObj = explodedObjects(i)   '多段线中第i条线段的长度
          length_Object = length_Object + lineObj.length  '该多段线，所有线段长度累加
          length = length + lineObj.length   '所有对象总长度累加
          explodedObjects(i).Delete
        Next
        ThisDrawing.Utility.Prompt "多段线长度=" & CStr(length_Object) & (Chr(13) & Chr(10))
     Case "AcDbLine"            '情况2，对象为直线。新增代码
        Set lineObj = acadObj
        length_Object = lineObj.length  '直线长度
        length = length + lineObj.length   '所有对象总长度累加
        ThisDrawing.Utility.Prompt "直线长度=" & CStr(length_Object) & (Chr(13) & Chr(10))
     Case "AcDbArc"
        Set arcObj = acadObj
        length_Object = arcObj.ArcLength '圆弧长度
        length = length + arcObj.ArcLength   '所有对象总长度累加
        ThisDrawing.Utility.Prompt "圆弧长度=" & CStr(length_Object) & (Chr(13) & Chr(10))
     End Select
     length_Object = 0#
  Next acadObj
  ThisDrawing.Utility.Prompt "所选中对象总长度=" & CStr(length)

End Sub

fjfhgdwfn

多段线可以直接用他的长度属性。在多段线中可能存在圆弧。