'附图为以下程序的结果。附图中出现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 |