|
|
'附图为以下程序的结果。附图中出现3个无意义的"命令："提示行，
'很不好看，如何抑制它们的出现？
Public Sub test()
Dim Obj As AcadObject
Dim sset As AcadSelectionSet
Dim ssetObj As AcadSelectionSet
On Error Resume Next
ThisDrawing.SelectionSets.Item("SsetObjects").Delete
ThisDrawing.SelectionSets.Item("SSETASSOC").Delete
On Error GoTo 0
Set sset = ThisDrawing.SelectionSets.Add("SsetObjects")
Set ssetObj = ThisDrawing.SelectionSets.Add("SSETASSOC")
sset.SelectOnScreen
For Each Obj In sset
Call SelectObject(Obj, ssetObj)
'MsgBox "Number of objects = " & ssetObj.Count
Next
End Sub
Private Sub SelectObject(Obj As Variant, ssetObj As Variant)
Dim pt As Variant
Dim sp(0 To 2) As Double
Dim ep(0 To 2) As Double
Dim mode As Integer
ssetObj.Clear
pt = Obj.StartPoint
sp(0) = pt(0)
sp(1) = pt(1)
sp(2) = pt(2)
pt = Obj.EndPoint
ep(0) = pt(0)
ep(1) = pt(1)
ep(2) = pt(2)
mode = acSelectionSetCrossing
ssetObj.Select mode, sp, ep '附图的命令提示由此方法产生
'其他处理
End Sub
|
|
置顶卡
