AutoCAD VBA函数---选择无编码实体

AutoCAD VBA函数---选择无编码实体

Public Sub mSelectEntityNoCode() '选择无编码实体
Dim strAppName As String
Dim sSet As AcadSelectionSet
Dim intCnt As Integer
Dim objEnt As AcadObject
Dim sSetNoCode As AcadSelectionSet
On Error Resume Next
strAppName = ThisDrawing.Application.ActiveDocument.Utility.GetString(1, vbCr & "输入应用程序名[south]:")
If strAppName = "" Then strAppName = "south"
intCnt = ThisDrawing.SelectionSets.count
While (intCnt > 0)
Set sSet = ThisDrawing.SelectionSets.Item(intCnt - 1)
sSet.Delete
intCnt = intCnt - 1
Wend
Set sSet = ThisDrawing.Application.ActiveDocument.SelectionSets.Add("ENT")
sSet.Select acSelectionSetAll
If sSet.count = 0 Then ThisDrawing.Application.ActiveDocument.Utility.Prompt vbCr & "图形文件中不存在实体。": Exit Sub
Set sSetNoCode = ThisDrawing.Application.ActiveDocument.SelectionSets.Add("NoCode")
For Each objEnt In sSet
If HasXData(objEnt, strAppName) = False Then addEntToSSet objEnt, sSetNoCode
Next
If sSetNoCode.count = 0 Then ThisDrawing.Application.ActiveDocument.Utility.Prompt vbCr & "未找到无编码实体。": Exit Sub
ThisDrawing.Application.Active
Document.SendCommand Chr(27) & Chr(27) & "SELECT" & vbCr & axSset2lspEnts(sSetNoCode) & vbCr & vbCr
End Sub