'将多个直线连成一条轻质多段线
Public Sub joinpoly(reg As AcadRegion)
reg.Explode
On Error Resume Next
Dim sset As AcadSelectionSet
If Not IsNull(ThisDrawing.SelectionSets.Item("joinpoly")) Then
Set sset = ThisDrawing.SelectionSets.Item("joinpoly")
sset.Delete
End If
Set sset = ThisDrawing.SelectionSets.Add("joinpoly")
Dim gpcode(1) As Integer
Dim datavalue(1) As Variant
gpcode(0) = 0
gpcode(1) = 8
datavalue(0) = "line"
datavalue(1) = reg.Layer
sset.Select acSelectionSetAll, , , gpcode, datavalue
Dim det As String
det = axSSet31spEnts(sset)
sset.Clear
ThisDrawing.SendCommand "_PEDIT" & vbCr & "M" & vbCr & det & vbCr & vbCr & "J" & vbCr & vbCr & vbCr
gpcode(0) = 0
gpcode(1) = 8
datavalue(0) = "LWPOLYLINE"
datavalue(1) = reg.Layer
sset.Select acSelectionSetAll, , , gpcode, datavalue
det = axSSet31spEnts(sset)
sset.Delete
ThisDrawing.SendCommand "_PEDIT" & vbCr & "M" & vbCr & det & vbCr & vbCr & "J" & vbCr & vbCr & vbCr '用 - pe方法
End Sub
Public Function axSSet31spEnts(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 = 0 To sset.Count - 1
entHandle = sset.Item(i).Handle
strEnts = strEnts & vbCr & "( handent" & Chr(34) & entHandle & Chr(34) & ")"
Next i
End If
axSSet31spEnts = strEnts
End Function