[分享]：运用ACADR2005的表格功能创建明细表

efan2000

2. 
   
3.   [FONT=courier new]
   
4. Sub Main()
   
5. 
   
6.     ' efan2000编写于2004-05-15
   
7.     ' 创建表格样式
   
8.     CreateTableStyle
   
9.     ' 创建块
   
10.     CreateBlock
    
11.     ' 创建表格
    
12.     CreateTable
    
13. End Sub
    
14. 
    
15. Sub CreateTableStyle()
    
16. 
    
17.     Dim DictObj As AcadDictionary
    
18.     Set DictObj = ThisDrawing.Database.dictionaries.Item("acad_tablestyle")
    
19. 
    
20.     Dim keyName As String
    
21.     Dim className As String
    
22.     Dim customObj As AcadTableStyle
    
23.     keyName = "明细表"
    
24.     className = "AcDbTableStyle"
    
25.     Set customObj = DictObj.AddObject(keyName, className)
    
26.    
    
27.     ' 表格样式名称
    
28.     customObj.Name = "明细表"
    
29.     customObj.Description = "明细表表格样式"
    
30.    
    
31.     ' 由上而下
    
32.     customObj.FlowDirection = acTableBottomToTop
    
33.    
    
34.     ' 边距
    
35.     customObj.HorzCellMargin = 0
    
36.     customObj.VertCellMargin = 0
    
37.    
    
38.     ' 取消标题行
    
39.     customObj.TitleSuppressed = True
    
40.     ' 列标题行，正中对齐，字高为5
    
41.     customObj.SetAlignment acHeaderRow, acMiddleCenter
    
42.     customObj.SetTextHeight acHeaderRow, 5
    
43.     ' 数据行，正中对齐，字高为3.5
    
44.     customObj.SetAlignment acDataRow, acMiddleCenter
    
45.     customObj.SetTextHeight acDataRow, 3.5
    
46. End Sub
    
47. 
    
48. Sub CreateBlock()
    
49.     Dim iPt(0 To 2) As Double
    
50.     iPt(0) = 0: iPt(1) = 0: iPt(2) = 0
    
51.     Dim BlockObj As AcadBlock
    
52.     Set BlockObj = ThisDrawing.Blocks.Add(iPt, "明细表-表头")
    
53.     iPt(0) = 5: iPt(1) = 10.5: iPt(2) = 0
    
54.     Dim MTextObj As AcadMText
    
55.     Set MTextObj = BlockObj.AddMText(iPt, 10, "单件")
    
56.     MTextObj.Height = 3.5
    
57.     MTextObj.AttachmentPoint = acAttachmentPointMiddleCenter
    
58.     MTextObj.InsertionPoint = iPt
    
59.     iPt(0) = 16: iPt(1) = 10.5: iPt(2) = 0
    
60.     Set MTextObj = BlockObj.AddMText(iPt, 12, "总计")
    
61.     MTextObj.Height = 3.5
    
62.     MTextObj.AttachmentPoint = acAttachmentPointMiddleCenter
    
63.     MTextObj.InsertionPoint = iPt
    
64.     iPt(0) = 11: iPt(1) = 3.5: iPt(2) = 0
    
65.     Set MTextObj = BlockObj.AddMText(iPt, 22, "重量")
    
66.     MTextObj.Height = 3.5
    
67.     MTextObj.AttachmentPoint = acAttachmentPointMiddleCenter
    
68.     MTextObj.InsertionPoint = iPt
    
69.     Set MTextObj = Nothing
    
70.     Dim sPt(0 To 2) As Double
    
71.     Dim ePt(0 To 2) As Double
    
72.     sPt(0) = 0: sPt(1) = 7: sPt(2) = 0
    
73.     ePt(0) = 22: ePt(1) = 7: ePt(2) = 0
    
74.     BlockObj.AddLine sPt, ePt
    
75.     sPt(0) = 10: sPt(1) = 14: sPt(2) = 0
    
76.     ePt(0) = 10: ePt(1) = 7: ePt(2) = 0
    
77.     BlockObj.AddLine sPt, ePt
    
78.     Set BlockObj = Nothing
    
79. End Sub
    
80. 
    
81. Sub CreateTable()
    
82.     ' 设置当前表格样式
    
83.     ThisDrawing.SetVariable "CTABLESTYLE", "明细表"
    
84.     Dim MSpaceObj As IAcadModelSpace2
    
85.     Set MSpaceObj = ThisDrawing.ModelSpace
    
86.     Dim iPt(0 To 2) As Double
    
87.     iPt(0) = 0: iPt(1) = 0: iPt(2) = 0
    
88.     Dim TableObj As AcadTable
    
89.     Set TableObj = MSpaceObj.AddTable(iPt, 2, 8, 7, 10)
    
90.     ThisDrawing.SetVariable "CTABLESTYLE", "Standard"
    
91.     ' 列标题行，行高为14，其余为7
    
92.     TableObj.SetRowHeight 0, 14
    
93.     ' 设置列宽
    
94.     TableObj.SetColumnWidth 0, 8
    
95.     ' 设置单元格文字
    
96.     TableObj.SetText 0, 0, "序号"
    
97.     TableObj.SetColumnWidth 1, 40
    
98.     TableObj.SetText 0, 1, "代  号"
    
99.     TableObj.SetColumnWidth 2, 44
    
100.     TableObj.SetText 0, 2, "名  称"
     
101.     TableObj.SetColumnWidth 3, 8
     
102.     TableObj.SetText 0, 3, "数量"
     
103.     TableObj.SetColumnWidth 4, 38
     
104.     TableObj.SetText 0, 4, "材  料"
     
105.     TableObj.SetColumnWidth 5, 10
     
106.     TableObj.SetColumnWidth 6, 12
     
107.     ' 合并，重量栏
     
108.     TableObj.MergeCells 0, 0, 5, 6
     
109.     ' 插入块，重理栏
     
110.     TableObj.SetBlockTableRecordId 0, 5, ThisDrawing.Blocks("明细表-表头").ObjectID, True
     
111.     TableObj.SetCellAlignment 0, 5, acTopCenter
     
112.     TableObj.SetColumnWidth 7, 20
     
113.     TableObj.SetText 0, 7, "备注"
     
114.     ' 数据行
     
115.     TableObj.SetText 1, 0, "1"
     
116. End Sub
     
117.   [/FONT]
     

<br />   [FONT=courier new]<br /> Sub Main()<br /> <br />     ' efan2000编写于2004-05-15<br />     ' 创建表格样式<br />     CreateTableStyle<br />     ' 创建块<br />     CreateBlock<br />     ' 创建表格<br />     CreateTable<br /> End Sub<br /> <br /> Sub CreateTableStyle()<br /> <br />     Dim DictObj As AcadDictionary<br />     Set DictObj = ThisDrawing.Database.dictionaries.Item("acad_tablestyle")<br /> <br />     Dim keyName As String<br />     Dim className As String<br />     Dim customObj As AcadTableStyle<br />     keyName = "明细表"<br />     className = "AcDbTableStyle"<br />     Set customObj = DictObj.AddObject(keyName, className)<br />     <br />     ' 表格样式名称<br />     customObj.Name = "明细表"<br />     customObj.Description = "明细表表格样式"<br />     <br />     ' 由上而下<br />     customObj.FlowDirection = acTableBottomToTop<br />     <br />     ' 边距<br />     customObj.HorzCellMargin = 0<br />     customObj.VertCellMargin = 0<br />     <br />     ' 取消标题行<br />     customObj.TitleSuppressed = True<br />     ' 列标题行，正中对齐，字高为5<br />     customObj.SetAlignment acHeaderRow, acMiddleCenter<br />     customObj.SetTextHeight acHeaderRow, 5<br />     ' 数据行，正中对齐，字高为3.5<br />     customObj.SetAlignment acDataRow, acMiddleCenter<br />     customObj.SetTextHeight acDataRow, 3.5<br /> End Sub<br /> <br /> Sub CreateBlock()<br />     Dim iPt(0 To 2) As Double<br />     iPt(0) = 0: iPt(1) = 0: iPt(2) = 0<br />     Dim BlockObj As AcadBlock<br />     Set BlockObj = ThisDrawing.Blocks.Add(iPt, "明细表-表头")<br />     iPt(0) = 5: iPt(1) = 10.5: iPt(2) = 0<br />     Dim MTextObj As AcadMText<br />     Set MTextObj = BlockObj.AddMText(iPt, 10, "单件")<br />     MTextObj.Height = 3.5<br />     MTextObj.AttachmentPoint = acAttachmentPointMiddleCenter<br />     MTextObj.InsertionPoint = iPt<br />     iPt(0) = 16: iPt(1) = 10.5: iPt(2) = 0<br />     Set MTextObj = BlockObj.AddMText(iPt, 12, "总计")<br />     MTextObj.Height = 3.5<br />     MTextObj.AttachmentPoint = acAttachmentPointMiddleCenter<br />     MTextObj.InsertionPoint = iPt<br />     iPt(0) = 11: iPt(1) = 3.5: iPt(2) = 0<br />     Set MTextObj = BlockObj.AddMText(iPt, 22, "重量")<br />     MTextObj.Height = 3.5<br />     MTextObj.AttachmentPoint = acAttachmentPointMiddleCenter<br />     MTextObj.InsertionPoint = iPt<br />     Set MTextObj = Nothing<br />     Dim sPt(0 To 2) As Double<br />     Dim ePt(0 To 2) As Double<br />     sPt(0) = 0: sPt(1) = 7: sPt(2) = 0<br />     ePt(0) = 22: ePt(1) = 7: ePt(2) = 0<br />     BlockObj.AddLine sPt, ePt<br />     sPt(0) = 10: sPt(1) = 14: sPt(2) = 0<br />     ePt(0) = 10: ePt(1) = 7: ePt(2) = 0<br />     BlockObj.AddLine sPt, ePt<br />     Set BlockObj = Nothing<br /> End Sub<br /> <br /> Sub CreateTable()<br />     ' 设置当前表格样式<br />     ThisDrawing.SetVariable "CTABLESTYLE", "明细表"<br />     Dim MSpaceObj As IAcadModelSpace2<br />     Set MSpaceObj = ThisDrawing.ModelSpace<br />     Dim iPt(0 To 2) As Double<br />     iPt(0) = 0: iPt(1) = 0: iPt(2) = 0<br />     Dim TableObj As AcadTable<br />     Set TableObj = MSpaceObj.AddTable(iPt, 2, 8, 7, 10)<br />     ThisDrawing.SetVariable "CTABLESTYLE", "Standard"<br />     ' 列标题行，行高为14，其余为7<br />     TableObj.SetRowHeight 0, 14<br />     ' 设置列宽<br />     TableObj.SetColumnWidth 0, 8<br />     ' 设置单元格文字<br />     TableObj.SetText 0, 0, "序号"<br />     TableObj.SetColumnWidth 1, 40<br />     TableObj.SetText 0, 1, "代  号"<br />     TableObj.SetColumnWidth 2, 44<br />     TableObj.SetText 0, 2, "名  称"<br />     TableObj.SetColumnWidth 3, 8<br />     TableObj.SetText 0, 3, "数量"<br />     TableObj.SetColumnWidth 4, 38<br />     TableObj.SetText 0, 4, "材  料"<br />     TableObj.SetColumnWidth 5, 10<br />     TableObj.SetColumnWidth 6, 12<br />     ' 合并，重量栏<br />     TableObj.MergeCells 0, 0, 5, 6<br />     ' 插入块，重理栏<br />     TableObj.SetBlockTableRecordId 0, 5, ThisDrawing.Blocks("明细表-表头").ObjectID, True<br />     TableObj.SetCellAlignment 0, 5, acTopCenter<br />     TableObj.SetColumnWidth 7, 20<br />     TableObj.SetText 0, 7, "备注"<br />     ' 数据行<br />     TableObj.SetText 1, 0, "1"<br /> End Sub<br />   [/FONT]<br />

ntchjie

2005的功能确实很大，可惜很多应用软件没有跟上来，所以放在机器里一直没有用。

唐僧肉

能不能将table变得像excel一样可以计算？

cuihongwei

VBA写的，可惜看不懂！

adisonmaster

先下载看看。