如何查找和统计这些块？

style6301 发表于 2007-11-2 15:52:00

在我的图形中含有多个（上百个）名为“zPanel”的块，块中有图号“DrawNO”／色卡“Color”／长度“Len”／宽度“Width”等属性，怎么样才能将这些统计数据写入DBF文件中。（已建有相同字段的D:\CYC\DeckP.dbf文件）

fjfhgdwfn 发表于 2007-11-3 19:06:00

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 发表于 2007-11-5 11:30:00

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

style6301 发表于 2007-11-9 09:52:00

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

页: [1]

明经CAD社区's Archiver

如何查找和统计这些块？