命令Boundary 与vba结合处理面域
本帖最后由 mycad 于 2013-5-8 16:51 编辑'今天做了一个面域的小程序,供大家交流,欢迎提供更好的方法供大家学习
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
boundary命令不一定能生成边界,缺少判断
页:
[1]