为什么我的块刷不出来？？？

passion884

为什么我的文件中本来有十几个块，执行vba程序刷新后且只能得到一个，而且块中所含的物体的数量也得不到？？ 代码如下： Private Sub cmdexplode_Click()
Dim objblock As AcadBlockReference
If txtcount.Text = 0 Then
MsgBox "图形中未存在之定的块参照", vbCritical
Exit Sub
End If
For Each objblock In ThisDrawing.ModelSpace
If objblock.Name = lstblocks.Text Then
objblock.Explode
objblock.Delete
End If
Next

txtcount.Text = CInt(txtcount.Text) - 1 End Sub Private Sub cmdgetpnt_Click()
Dim returnobject As Object
Dim elem As Object
Dim basepnt As Variant
i = 1 For Each elem In returnobject
If elem.ObjectName = "AcDbAttributeDefinition" Then
basepnt = i
i = i + 1
End If
Next
txtcount = basepnt
End Sub Private Sub UserForm_Initialize()
refresh
txtcount.Enabled = False
txtatt.Enabled = False End Sub
Sub blockmanage()
form1.Show

End Sub
Private Sub refresh()
Dim blocklist As Collection

On Error Resume Next

Set blocklist = getblocks

If blocklist Is Nothing Then
MsgBox "当前图形中不存在任何块", vbCritical
Exit Sub
End If

refreshlist lstblocks, blocklist

If lstblocks.ListIndex = -1 Then
lstblocks.ListIndex = 0
End If

Exit Sub

errhandle:
MsgBox "在更新列表的过程中发生如下错误：" & Err.Description, vbCritical
End

End Sub Private Function getblocks() As Collection
Dim blocklist As New Collection
Dim icount As Long
Dim acadobject As AcadBlock

For Each acadobject In ThisDrawing.Blocks
If acadobject.IsLayout = False Then
blocklist.Add acadobject.Name, acadobject.Name
End If
Next

If blocklist.Count > 0 Then
Set getblocks = blocklist
Else
Set getblocks = Nothing
End If
End Function Private Sub refreshlist(ByRef lstobject As ListBox, ByRef blocklist As Collection)
lstblocks.Clear

Dim icount As Integer
For icount = 1 To blocklist.Count
addsorted lstobject, blocklist(icount)
Next
End Sub


Private Sub lstblocks_click()
On Error Resume Next
Dim blockname As String
Dim i As Integer
Dim num As Integer
i = 0

txtatt.Text = "无"

blockname = lstblocks.Text
Dim blkref As AcadBlockReference
For Each blkref In ThisDrawing.ModelSpace
If blkref.Name = blockname Then
i = i + 1
If blkref.HasAttributes Then
txtatt.Text = "有"
End If
End If
Next blkref

txtcount.Value = i
End Sub
Private Sub addsorted(ByRef lstobject As ListBox, ByRef sitem As String)
Dim icount As Long
If lstobject.ListCount = 0 Then
lstobject.AddItem sitem
GoTo finish
End If

For icount = 0 To (lstobject.listciunt - 1)
If StrComp(lstobject.List(icount), sitem, vbTextCompare) = 1 Then
GoTo finish
End If
Next

lstobject.AddItem sitem

finish:
End Sub

zfbj

为什么我的文件中本来有十几个块，执行vba程序刷新后且只能得到一个？？？


不太明白你的意思，请详细描述一下，时间太紧，没有看代码。

passion884

就是说，通过执行         eattext 命令，可以看出文件中总共有十几个块，但是我通过上述代码对图形进行扫描刷新，在文本框中只能得到一个块，而且这个块的所包含的物体的个数也无法显示（代码中有相关部分 令文本框中所选中的块 显示他的包含物体的数量），不知道为什么。