|
|
'今天做了一个面域的小程序，供大家交流，欢迎提供更好的方法供大家学习
Public Sub GM2()
Dim layerobj As AcadLayer
Dim sset As AcadSelectionSet
Dim lwobj As AcadLWPolyline
On Error Resume Next
Set layerobj = ThisDrawing.Layers.Add("MMM")
Dim returnPnt As Variant
returnPnt = ThisDrawing.Utility.GetPoint(, vbCrLf & "请拾取一点:")
ThisDrawing.SendCommand "_-boundary " & vbCrLf & Trim(returnPnt(0)) + "," & Trim(returnPnt(1)) & vbCrLf
If Not IsNull(ThisDrawing.SelectionSets.Item("this")) Then
Set sset = ThisDrawing.SelectionSets.Item("this")
sset.Delete
End If
Set sset = ThisDrawing.SelectionSets.Add("this")
sset.Select acSelectionSetLast
sset.Select acSelectionSetLast
Set lwobj = sset.Item(0)
lwobj.Layer = "MMM"
lwobj.color = acRed
sset.Delete
'line:
End Sub
|
|
置顶卡
