|
|
在网上搜集合并多段线的代码，运行了，还是合并不了，估计问题出在选择对象上，希望大家指导下：
' 转换多个图元的函数
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 |
|
置顶卡
