关于CADVBA选择集的问题。
我最近编了一个可以在CAD里矩形窗选选择集的程序，但不知为什么，只成功了一次，以后再也不行了，请各位高手看看！谢谢！Dim entss As AcadSelectionSet
frmMain.Hide
On Error Resume Next
Set xlapp = GetObject(, "excel.application")
If Err Then
Err.Clear
Set xlapp = CreateObject("excel.application")
If Err Then
Err.Clear
MsgBox ("不能运行EXCEL，请检查是否安装了EXCEL")
Exit Sub
End If
End If
aablkname = xlapp.ActiveSheet.Cells(2, 2).Value
MsgBox aablkname
Dim sco As Integer
Dim mode As Integer
mode = acSelectionSetWindow
Dim pp(0 To 11) As Double
Dim ppt1 As Variant
Dim ppt2 As Variant
ppt1 = ThisDrawing.Utility.GetPoint(, "请选择第一点!")
ppt2 = ThisDrawing.Utility.GetPoint(, "请选择第二点!")
Set entss = ThisDrawing.SelectionSets.Add("ssss1")
Call entss.Select(mode, ppt1, ppt2)
sco = entss.count '计算选择集中的对象数
MsgBox "选中对象数:" & CStr(sco) '显示对话框
For Each eent In entss
If TypeOf eent Is AcadBlockReference Then
If StrComp(eent.Name, aablkname, vbTextCompare) = 0 Then
Set acadBlkTitleRef = eent
varAttributes = acadBlkTitleRef.GetAttributes
ubo = UBound(varAttributes)
For cnt = LBound(varAttributes) To UBound(varAttributes)
For cnt1 = LBound(varAttributes) To UBound(varAttributes)
If xlapp.Worksheets("sheet1").Cells(3, cnt1 + 1).Value = varAttributes(cnt).TagString Then
xlapp.Worksheets("sheet1").Cells(ii + 4, cnt1 + 1).Value = varAttributes(cnt).TextString
Exit For
End If
Next
Next
ii = ii + 1
End If
End If
Next eent
每次显示的选择集实体数目都是0！ 每个选集名称只能用一次，建议做成
Set entss = ThisDrawing.SelectionSets.Add("ssss1" & time)
用完之后，用一次
entss.Delete
之所以在("ssss1" & time）这里加时间，如果程序中间有出错，没有删除掉选集，也不会重名而报错 楼上正确！！1 hqpo 发表于 2014-6-20 01:02 static/image/common/back.gif
楼上正确！！1
非常感谢！
页:
[1]