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

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:42

自己顶一下咯

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

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:33

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

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

crazylsp 发表于 2012-5-11 16:26 static/image/common/back.gif
strEnts = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
strEnts = strEnts & vbCr & "(handent "...

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

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

关注

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

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

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

请参阅
http://bbs.mjtd.com/thread-16296-1-1.html

最后的晨露 发表于 2013-1-12 12:05:58

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