oyy0113 发表于 2009-9-9 20:22:00

求助：关于选择集的程序

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

雪山飞狐_lzh 发表于 2009-9-9 20:47:00

<p>选择集里只能放模型空间和图纸空间的实体</p><p></p><p>引用ObjectDbx库</p><p>Sub tt()</p><p>&nbsp;&nbsp;&nbsp; Dim blk&nbsp; As AcadBlock<br/>&nbsp;&nbsp;&nbsp; Set blk = ThisDrawing.Blocks("A")<br/>&nbsp;&nbsp;&nbsp; Dim arr() As Object<br/>&nbsp;&nbsp;&nbsp; ReDim arr(blk.Count - 1)<br/>&nbsp;&nbsp;&nbsp; For i = 0 To blk.Count - 1<br/>&nbsp;&nbsp;&nbsp; Set arr(i) = blk(i)<br/>&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; Dim doc As New AxDbDocument<br/>&nbsp;&nbsp;&nbsp; ThisDrawing.CopyObjects arr, doc.ModelSpace<br/>&nbsp;&nbsp;&nbsp; doc.SaveAs "d:/11.dwg"</p><p>End Sub</p>

oyy0113 发表于 2009-9-20 11:44:00

非常感谢！
页: [1]
查看完整版本: 求助：关于选择集的程序