用这个程序，可以多选！
Sub jcx()
Dim a
On Error Resume Next
Dim i As Integer
Dim allobj As AcadEntity '声明对象
Dim spnt As Variant '声明直线的开始点坐标
Dim epnt As Variant '声明直线的结束点坐标
Dim plineobj As AcadLWPolyline '声明细多段线
Dim ver(0 To 3) As Double '声明细多段线坐标点数组
For i = 0 To ThisDrawing.SelectionSets.Count - 1
ThisDrawing.SelectionSets.Item(i).Clear
ThisDrawing.SelectionSets.Item(i).Delete
Next
Dim sset As AcadSelectionSet
Set sset = ThisDrawing.SelectionSets.Add("lineset")
sset.SelectOnScreen
If sset.Count = 0 Then Exit Sub
Dim w As String
w = ThisDrawing.Utility.GetString(1, vbCrLf & "请输入宽度:")
For Each allobj In sset '遍历空间的每一个对象
If allobj.ObjectName "AcDbLine" Then '若为多段线
allobj.ConstantWidth = w
End If
If allobj.ObjectName = "AcDbLine" Then '若为直线
spnt = allobj.StartPoint '将直线的开始点坐标赋值到spnt
epnt = allobj.EndPoint ''将直线的结束点坐标赋值到epnt
'将坐标写入数组
ver(0) = spnt(0): ver(1) = spnt(1)
ver(2) = epnt(0): ver(3) = epnt(1)
'生成多段线
Set plineobj = ThisDrawing.ModelSpace.AddLightWeightPolyline(ver)
'线宽为2
plineobj.ConstantWidth = w
allobj.Delete
End If
'删除直线Next '循环至下一对象
Exit Sub
End Sub
置顶卡
