mycad 发表于 2013-5-8 16:49:36

命令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


yshf 发表于 2013-7-19 16:46:01

boundary命令不一定能生成边界,缺少判断
页: [1]
查看完整版本: 命令Boundary 与vba结合处理面域