[编程交流] 创建文件并运行代码

Private Sub CommandButtonSmooth_Click()
Dim sset As AcadSelectionSet
Dim v(0) As Variant
Dim lifiltertype(0) As Integer
Dim plineObj As AcadLWPolyline
Dim oLWP As AcadLWPolyline
Dim i As Long
Dim var As Variant
Dim oSS() As AcadEntity
Dim oGr As AcadGroup
Set oGr = ThisDrawing.Groups.Add("QWERT")
Set sset = Nothing
For i = 0 To ThisDrawing.SelectionSets.Count - 1
Set sset = ThisDrawing.SelectionSets.Item(i)
If sset.Name = "ss1" Then
sset.Clear
Exit For
Else
Set sset = Nothing
End If
Next i
If sset Is Nothing Then
Set sset = ThisDrawing.SelectionSets.Add("ss1")
End If
'create a selection set of all the entities on a given layer
'here they are all lw polylines
lifiltertype(0) = 8
v(0) = "jhl_9.25_begin"
sset.Select acSelectionSetAll, , , lifiltertype, v
ReDim Preserve oSS(0 To sset.Count - 1) As AcadEntity
For i = 0 To sset.Count - 1
Set oSS(i) = sset.Item(i)
Next i
'add plines to group
oGr.AppendItems oSS
Dim GRname As String
GRname = oGr.Name
' using SendCommand method with Group
ThisDrawing.SendCommand "_PEDIT" & vbCr & "M" & vbCr & "G" & vbCr & GRname & vbCr & vbCr & "J" & vbCr & "0.0" & vbCr & vbCr
' deleting group and clearing selection set
oGr.Delete
sset.Clear
'start to pedit spline or fit here
Dim oGroup As AcadGroup
Set oGroup = ThisDrawing.Groups.Add("ZERO")
GRname = oGroup.Name
'select all the joined plines
sset.Select acSelectionSetAll, , , lifiltertype, v
ReDim Preserve oSS(0) As AcadEntity
For i = 0 To sset.Count - 1
Set oLWP = sset.Item(i)
Set oSS(0) = sset.Item(i)
'create group with one item
oGroup.AppendItems oSS
If oLWP.Closed Then
'Spline
ThisDrawing.SendCommand "_PEDIT" & vbCr & "M" & vbCr & "G" & vbCr & GRname & vbCr & vbCr & "S" & vbCr & vbCr
Else
'Fit
ThisDrawing.SendCommand "_PEDIT" & vbCr & "M" & vbCr & "G" & vbCr & GRname & vbCr & vbCr & "F" & vbCr & vbCr
End If
'remove the pline from the group
oGroup.RemoveItems oSS
Next i
sset.Delete
oGroup.Delete
End Sub

Private Sub CommandButtonSmooth_Click()
now
Private Sub test()