高手看看，哪里的问题？

yydpj · 发表于 2008-3-24 14:04:00

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 · 发表于 2008-3-24 16:35:00

没人回答么？

雪山飞狐_lzh · 发表于 2008-3-24 18:55:00

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

fjfhgdwfn · 发表于 2008-3-25 10:29:00

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 · 发表于 2008-3-25 11:37:00

可以了/
谢谢谢谢，万分感谢中

yydpj · 发表于 2008-3-25 14:19:00

又一个问题
想将程序改成，当前模型空间内选中的多段线的总长度，怎么更改一下？
For Each acadObj In ThisDrawing.ModelSpace '
改成 For Each acadObj In ThisDrawing.SelectionSets 好象根本不对
新手新手，问题有点幼稚，不要笑话~~~

雪山飞狐_lzh · 发表于 2008-3-25 20:28:00

For Each acadObj In ThisDrawing.PickfirstSelectionSet
不过用前看看置顶的“先选择后执行”的帖子

yydpj · 发表于 2008-3-26 08:19:00

谢谢~~~~
OK了

yydpj · 发表于 2008-3-26 09:27:00

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 · 发表于 2008-3-26 16:09:00

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

高手看看，哪里的问题？

发表回复

精选推荐