☆一笑而过☆ 发表于 2012-5-10 09:54:00

vba cad合并多段线

在网上搜集合并多段线的代码，运行了，还是合并不了，估计问题出在选择对象上，希望大家指导下：
' 转换多个图元的函数
Public Function axSSet2lspEnts(ByVal SSet As AcadSelectionSet) As String
    If SSet.Count = 0 Then Exit Function
    Dim entHandle As String
    Dim strEnts As String
    entHandle = SSet.Item(0).Handle
    strEnts = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
    If SSet.Count > 1 Then
      Dim i As Integer
      For i = 1 To SSet.Count - 1
            entHandle = SSet.Item(i).Handle
            strEnts = strEnts & vbCr & "(handent " & Chr(34) & entHandle & Chr(34) & ")"
      Next i
    End If
    axSSet2lspEnts = strEnts
End Function
' 连接多段线
Public Function EditPline(ByVal pt1 As Variant, ByVal pt2 As Variant) As AcadPolyline
On Error Resume Next
Dim det As Variant
Dim FilterType As Integer
Dim FilterData As Variant
FilterType = 0                                 '按类型选择
FilterData = "Polyline"
Dim SSet As AcadSelectionSet
    If Not IsNull(ThisDrawing.SelectionSets.Item("PLineSet")) Then
      Set SSet = ThisDrawing.SelectionSets.Item("PLineSet")
      SSet.Delete
    End If
    Set SSet = ThisDrawing.SelectionSets.Add("PLineSet")
SSet.Delete
    SSet.Select acSelectionSetCrossing, pt1, pt2, FilterType, FilterData
    det = axSSet2lspEnts(SSet)
    ' 使用SendCommand听后方法完成连接操作
    ThisDrawing.SendCommand "_PEDIT" & vbCr & "M" & vbCr & det & vbCr & "J" & vbCr & det & "0.000" & vbCr & vbCr
End Function

☆一笑而过☆ 发表于 2012-5-11 15:10:00

自己顶一下咯

crazylsp 发表于 2012-5-11 16:26:00

strEnts = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
strEnts = strEnts & vbCr & "(handent " & Chr(34) & entHandle & Chr(34) & ")" 转换过就是
strEnts = "(handent "    " entHandle "    ")"
strEnts = strEnts   回车   " (handent "   " entHandle"   ")   "
               "(handent "    " entHandle "    ")"回车   " (handent "   " entHandle"   ")   "
是不是 "(handent "    " entHandle "    ")" 会是" ("handent "    " entHandle "    )" ?

☆一笑而过☆ 发表于 2012-5-11 17:21:00

水平有限，没看懂是什么意思？

☆一笑而过☆ 发表于 2012-5-11 17:24:00


水平有限，没看懂是什么意思？

3xxx 发表于 2012-5-11 17:24:00

关注

万里天 发表于 2013-1-10 13:24:00

用ThisDrawing.SendCommand "_PEDIT"的方式只能合并首位重合的多段线.

mikewolf2k 发表于 2013-1-11 08:59:00

请参阅
页: [1]
查看完整版本: vba cad合并多段线