为什么我的块刷不出来？？？
为什么我的文件中本来有十几个块，执行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 SubPrivate 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 SubPrivate 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 SubPrivate 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 FunctionPrivate 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 为什么我的文件中本来有十几个块，执行vba程序刷新后且只能得到一个？？？
不太明白你的意思，请详细描述一下，时间太紧，没有看代码。 就是说，通过执行 eattext 命令，可以看出文件中总共有十几个块，但是我通过上述代码对图形进行扫描刷新，在文本框中只能得到一个块，而且这个块的所包含的物体的个数也无法显示（代码中有相关部分 令文本框中所选中的块 显示他的包含物体的数量），不知道为什么。
页:
[1]