进来讨论一下如何合并多段线

倖福-吖-rao · 发表于 2014-4-18 17:54:00

小弟刚编完一个软件，是VBA编程的。做完后想把整个图形做一次多段线合并操作。查阅了不少资料，最后别人给我一段代码，原本
他那个都是三维多段线画的，我的是二维，就稍微改了下，可是运行程序也不能合并多段线，也不报错，希望有人能帮忙分析下我的
代码，看看哪里错了，谢谢哦！！
Dim PlineObj As AcadLWPolyline
Dim ss_line As AcadSelectionSet
Dim ent As AcadEntity
Dim line_code(0) As Integer
Dim line_value(0) As Variant
Dim coord As Variant
' Dim i, j As Long
' On Error GoTo errexit
Set ss_line = AcadApp.ActiveDocument.SelectionSets.Add("sPolyLines")
line_code(0) = 0
line_value(0) = "POLYLINE"
ss_line.Select acSelectionSetAll ', , , line_code, line_value
      For Each ent In ss_line
'          ent.color = acGreen
         If ent.ObjectName = "AcadLWPolyline" Then
            Dim PL2D() As Double
            Dim count As Integer
            Dim ent2D As AcadLWPolyline
            Set ent2D = ent
            ent.color = acGreen
            count = (UBound(ent2D.Coordinates) + 1) / 2
            ReDim Preserve PL2D(cuunt * 2 - 1) As Double
            For j = 0 To UBound(ent2D.Coordinates) / 2
                  PL2D(j * 2) = ent2D.Coordinates(j * 2)
                  PL2D(j * 2 + 1) = ent2D.Coordinates(j * 2 + 1)
            Next

            Set PlineObj = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(PL2D)
            PlineObj.Closed = ent2D.Closed
            PlineObj.color = ent2D.color
            PlineObj.Linetype = ent2D.Linetype
            PlineObj.Layer = ent2D.Layer
            PlineObj.LinetypeScale = ent2D.LinetypeScale
            PlineObj.Lineweight = ent2D.Lineweight
            ent2D.Delete
         End If
         ent.Update
      Next
'errexit:
' ss_line.Clear
ss_line.Delete