求助：关于选择集的程序

oyy0113

我写了个保存块的程序，但是保存不了，那位大虾帮帮忙啊！

Private Sub cmdSave_Click()
    Dim uSset As AcadSelectionSet
    Dim iCount As Integer
    Dim AcadObject As AcadBlock
    Dim uBlock(1 To 1) As AcadBlock
    Set uSset = ThisDrawing.SelectionSets.Add("WBLOCKSET10")
    For Each AcadObject In ThisDrawing.Blocks
        If AcadObject.IsLayout = False And AcadObject.Name = ListBox1.Text Then '列表框的内容是要保存的块的名字
            Set uBlock(1) = AcadObject
        End If
    Next
    uSset.AddItems uBlock
    'msgbox uSset.count
    '我作了下测试，uSset.count还是0.那就是说uSset.AddItems uBlock没有添加成功，这事为什么啊？
    ThisDrawing.Wblock "C:\block.dwg", uSset
    uSset.Delete
End Sub

雪山飞狐_lzh

选择集里只能放模型空间和图纸空间的实体

引用ObjectDbx库

Sub tt()

    Dim blk  As AcadBlock
    Set blk = ThisDrawing.Blocks("A")
    Dim arr() As Object
    ReDim arr(blk.Count - 1)
    For i = 0 To blk.Count - 1
    Set arr(i) = blk(i)
    Next
   
    Dim doc As New AxDbDocument
    ThisDrawing.CopyObjects arr, doc.ModelSpace
    doc.SaveAs "d:/11.dwg"

End Sub

oyy0113

非常感谢！