如何查找和统计这些块？

style6301

在我的图形中含有多个（上百个）名为“zPanel”的块，

块中有图号“DrawNO”／色卡“Color”／长度“Len”／宽度“Width”等属性，

怎么样才能将这些统计数据写入DBF文件中。（已建有相同字段的D:\CYC\DeckP.dbf文件）

fjfhgdwfn

Sub Example_Select_text() '低等级表形式
  
    Dim ssetObj As AcadSelectionSet
    Dim CONUT As Integer
    CONUT = 0
    Count = ThisDrawing.SelectionSets.Count
     For I = 0 To Count - 1 '删除所有的选择集
    Set ssetObj = ThisDrawing.SelectionSets.Item(0)
      ssetObj.Delete
    Next I
  
   Dim sjx, dmx As AcadSelectionSet
 
   
   Dim FilterType(1) As Integer
   Dim FilterData(1) As Variant
   Set sjx = ThisDrawing.SelectionSets.Add("sjx")
   Set dmx = ThisDrawing.SelectionSets.Add("dmx")

   FilterType(0) = 2
   FilterData(0) = "TK" '是块名

   'FilterType(1) = 62
   'FilterData(1) = 10  '颜色是3

   FilterType(1) = 8
   FilterData(1) = "0"  '图层是0
  
   Dim mode As Integer
  Dim doc2 As AcadDocument
 Set doc2 = ThisDrawing.ModelSpace.Document
 
 mode = acSelectionSetAll
 'sjx.Select mode, , , FilterType, FilterData
  sjx.SelectOnScreen FilterType, FilterData '得到图框
    Dim newvarAttributes, inpoint, entry1 As Variant
    Dim ss, sss, ssss As String
    Dim sjxcount As Integer
    sjxcount = sjx.Count
    
     Dim templateFileName As String
   Dim DOC1 As AcadDocument
    ReDim objects(sjxcount - 1) As AcadEntity
      Dim retObjects As Variant
    Dim minExt As Variant
     Dim maxExt As Variant

  
 
     For Each ENTRY In sjx

     newvarAttributes = ENTRY.GetAttributes '得到图框块的属性，即图名图号页码
   
     ENTRY.GetBoundingBox minExt, maxExt '得到图框的最大最小坐标
     mode = acSelectionSetWindow 'acSelectionSetPrevious 'acSelectionSetCrossing
     ThisDrawing.Application.ZoomWindow minExt, maxExt
    
     dmx.Select mode, minExt, maxExt '选择图框内的对象
    
     ReDim objects(dmx.Count - 1) As AcadEntity
        I = 0
      For Each entry1 In dmx
      Set objects(I) = entry1
      I = I + 1
      Next entry1
      Set DOC1 = Documents.Add
     doc2.CopyObjects objects, DOC1.ModelSpace '拷贝对象到新文件中
     ThisDrawing.Application.ZoomWindow minExt, maxExt
   
   DOC1.SaveAs doc2.Path & "\" & newvarAttributes(1).TextString & "(" & newvarAttributes(2).TextString & ")" & newvarAttributes(0).TextString
     DOC1.Close
    
     dmx.Clear
     Next ENTRY
   

 
 
End Sub

这个功能是实现把0层按块名为“ＴＫ”的块，把一张图会成多张。在存文件名时。用到了属性，

你仔细看下吧。应可以满足你的要求。

style6301

十分感谢您的回复，我会认真地研究您提供的源码，谢谢！

style6301

我已经顺利的将图块中的属性提取出来，但如何才能形成Visual Foxpro6.0识别的DBF文件？