快帮我看看这个有关＂选择集＂子程序怎么运行不了啊？？？

sus1982

下面编码先判断选择集是否存在再对其操作，可运行后老是弹出＂未找到关键字＂的错误信息．就是不知道问题出在哪里？请高手帮我看看！！！

Sub addrelativitylin()
   Dim lineSelection1 As AcadSelectionSet
   If Not IsNull(ThisDrawing.SelectionSets.Item("lineSelection1")) Then
      Set lineSelection1 = ThisDrawing.SelectionSets.Item("NewSelectionSet")
      selset.Delete
   End If
   Set lineSelection1 = ThisDrawing.SelectionSets.Add("NewSelectionSet")
   MsgBox "the new is" & lineSelection1.Name, vbInformation, "SelectionSets Example"
End Sub

zhuxuhong

selset.Delete 改为lineSelection1.delete 试试

sus1982

不行啊,用楼上的方法还是出现弹出＂未找到关键字＂的错误信息.

调试的时候提示好象是" If Not IsNull(ThisDrawing.SelectionSets.Item("lineSelection1")) Then" 这里出了什么问题!

 可就是不知道在哪里出了问题

 

zhuxuhong

Function CreateSelectionSet(Optional SSetName As String = "mjtd") As AcadSelectionSet
    On Error Resume Next
    ThisDrawing.SelectionSets(SSetName).Delete
    Set CreateSelectionSet = ThisDrawing.SelectionSets.Add(SSetName)
End Function

用这段试试

sus1982

用"On Error Resume Next" 可以了

谢谢楼上大哥了

sus1982

我用Sset.SelectOnScreen给新建的选择集添加对象,可老是选不上对象,下面代码没反应,请高手们帮我看看把

Sub addrelativityline()
   Dim lineSelection1 As AcadSelectionSet
   On Error Resume Next
 ThisDrawing.SelectionSets("SSl").Delet
   Set lineSelection1 = ThisDrawing.SelectionSets.Add("SSl")
   Sset.SelectOnScreen
   ThisDrawing.ModelSpace.lineSelection1.Erase
End Sub