为什么我的块刷不出来？？？
为什么我的文件中本来有十几个块，执行vba程序刷新后且只能得到一个，而且块中所含的物体的数量也得不到？？代码如下：
Private Sub cmdexplode_Click()<BR>Dim objblock As AcadBlockReference<BR>If txtcount.Text = 0 Then<BR>MsgBox "图形中未存在之定的块参照", vbCritical<BR>Exit Sub<BR>End If<BR>For Each objblock In ThisDrawing.ModelSpace<BR> If objblock.Name = lstblocks.Text Then<BR> objblock.Explode<BR> objblock.Delete<BR> End If<BR> Next<BR> <BR> txtcount.Text = CInt(txtcount.Text) - 1
End Sub
Private Sub cmdgetpnt_Click()<BR>Dim returnobject As Object<BR>Dim elem As Object<BR>Dim basepnt As Variant<BR>i = 1
For Each elem In returnobject<BR> If elem.ObjectName = "AcDbAttributeDefinition" Then<BR> basepnt = i<BR> i = i + 1<BR> End If<BR> Next<BR> txtcount = basepnt<BR>End Sub
Private Sub UserForm_Initialize()<BR>refresh<BR>txtcount.Enabled = False<BR>txtatt.Enabled = False
End Sub<BR>Sub blockmanage()<BR> form1.Show<BR> <BR>End Sub<BR>
Private Sub refresh()<BR> Dim blocklist As Collection<BR> <BR> On Error Resume Next<BR> <BR> Set blocklist = getblocks<BR> <BR> If blocklist Is Nothing Then<BR> MsgBox "当前图形中不存在任何块", vbCritical<BR> Exit Sub<BR> End If<BR> <BR> refreshlist lstblocks, blocklist<BR> <BR> If lstblocks.ListIndex = -1 Then<BR> lstblocks.ListIndex = 0<BR> End If<BR> <BR> Exit Sub<BR> <BR>errhandle:<BR> MsgBox "在更新列表的过程中发生如下错误：" & Err.Description, vbCritical<BR> End<BR> <BR>End Sub
Private Function getblocks() As Collection<BR> Dim blocklist As New Collection<BR> Dim icount As Long<BR> Dim acadobject As AcadBlock<BR> <BR> For Each acadobject In ThisDrawing.Blocks<BR> If acadobject.IsLayout = False Then<BR> blocklist.Add acadobject.Name, acadobject.Name<BR> End If<BR> Next<BR> <BR> If blocklist.Count > 0 Then<BR> Set getblocks = blocklist<BR> Else<BR> Set getblocks = Nothing<BR> End If<BR>End Function
Private Sub refreshlist(ByRef lstobject As ListBox, ByRef blocklist As Collection)<BR> lstblocks.Clear<BR> <BR> Dim icount As Integer<BR> For icount = 1 To blocklist.Count<BR> addsorted lstobject, blocklist(icount)<BR> Next<BR> End Sub<BR> <BR> <BR>
Private Sub lstblocks_click()<BR> On Error Resume Next<BR> Dim blockname As String<BR> Dim i As Integer<BR> Dim num As Integer<BR> i = 0<BR> <BR> txtatt.Text = "无"<BR> <BR> blockname = lstblocks.Text<BR> Dim blkref As AcadBlockReference<BR> For Each blkref In ThisDrawing.ModelSpace<BR> If blkref.Name = blockname Then<BR> i = i + 1<BR> If blkref.HasAttributes Then<BR> txtatt.Text = "有"<BR> End If<BR> End If<BR> Next blkref<BR> <BR> txtcount.Value = i<BR> End Sub<BR>
Private Sub addsorted(ByRef lstobject As ListBox, ByRef sitem As String)<BR> Dim icount As Long<BR> If lstobject.ListCount = 0 Then<BR> lstobject.AddItem sitem<BR> GoTo finish<BR> End If<BR> <BR> For icount = 0 To (lstobject.listciunt - 1)<BR> If StrComp(lstobject.List(icount), sitem, vbTextCompare) = 1 Then<BR> GoTo finish<BR> End If<BR> Next<BR> <BR> lstobject.AddItem sitem<BR> <BR>finish:<BR> End Sub 为什么我的文件中本来有十几个块，执行vba程序刷新后且只能得到一个？？？
不太明白你的意思，请详细描述一下，时间太紧，没有看代码。 就是说，通过执行 eattext 命令，可以看出文件中总共有十几个块，但是我通过上述代码对图形进行扫描刷新，在文本框中只能得到一个块，而且这个块的所包含的物体的个数也无法显示（代码中有相关部分 令文本框中所选中的块 显示他的包含物体的数量），不知道为什么。
页:
[1]