lisp 多段线转面域_晓东CAD家园-论坛-晓东工具箱、编程申请-[编程申请]：批量面域转成闭合多段线!!!!-批量面域转成闭合多段线!!!! - Powered by Discuz!...

'将多个直线连成一条轻质多段线

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