关于CADVBA选择集的问题。

weixin7944

我最近编了一个可以在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

weixin7944

每次显示的选择集实体数目都是0！

goggoo

每个选集名称只能用一次，建议做成
Set entss = ThisDrawing.SelectionSets.Add("ssss1" & time)

用完之后，用一次
entss.Delete


之所以在("ssss1" & time）这里加时间，如果程序中间有出错，没有删除掉选集，也不会重名而报错

hqpo

楼上正确！！1

weixin7944

hqpo 发表于 2014-6-20 01:02
楼上正确！！1

非常感谢！