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

efan2000

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

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

雪山飞狐_lzh

好！学习中

yingxunxue

cAD2004的可以吗？


怎么做修改，我想用此程序做我的标题栏

illuminiti

Dim DictObj As AcadDictionary
       Set DictObj = ThisDrawing.Database.dictionaries.Item("acad_tablestyle")       Dim keyName As String
       Dim className As String
       Dim customObj As AcadTableStyle
       keyName = "明细表"
       className = "AcDbTableStyle"
       Set customObj = DictObj.AddObject(keyName, className)
我把这段代码拿来调试，提示错误：系统注册表中不存在 AcRxClassName 项。
这个该怎么解决 ？望指点

新鲜8

谢谢分享太有用了