[原创]：Layout - AutoCAD中的报表工具

rave

AutoCAD2000中引入的Layout是一个非常好用的报表工具
请参照下面的例程

2. 
   
3. '纯文本报表(生成一个无PViewport的Layout)
   
4. Private Sub NewTextLayout(LayoutName, PaperSize As String, Rotate As Boolean)
   
5.   Dim TempLayout As AcadLayout
   
6.   
   
7.   Set TempLayout = ThisDrawing.Layouts.Add(LayoutName)
   
8.   TempLayout.CanonicalMediaName = PaperSize
   
9.   If Rotate Then
   
10.     TempLayout.PlotRotation = ac90degrees
    
11.   Else
    
12.     TempLayout.PlotRotation = ac0degrees
    
13.   End If
    
14.   ThisDrawing.ActiveLayout = TempLayout
    
15.   ThisDrawing.ActiveSpace = acPaperSpace
    
16.   ThisDrawing.MSpace = False
    
17.   '删除系统缺省添加的PViewPort
    
18.   ThisDrawing.PaperSpace.Item(1).Delete
    
19. End Sub
    
20. 
    
21. '写文字
    
22. Private Sub DrawText(textString, strFont As String, X, Y, height As Double)
    
23.   Dim textObj As AcadText
    
24.   Dim pt(0 To 2) As Double
    
25.   
    
26.   pt(0) = X
    
27.   pt(1) = Y
    
28.   pt(2) = 0
    
29.   ThisDrawing.ActiveTextStyle = ThisDrawing.TextStyles.Item(strFont)
    
30.   Set textObj = ThisDrawing.PaperSpace.AddText(textString, pt, height)
    
31. End Sub
    
32. 
    
33. '写Align文字
    
34. Private Sub DrawAlignText(textString, strFont As String, insX, insY, alnX, alnY, height As
    
35. 
    
36. Double, strAln As String)
    
37.   Dim textObj As AcadText
    
38.   Dim insPt(0 To 2) As Double
    
39.   Dim alnPt(0 To 2) As Double
    
40.   Dim Align As AcAlignment
    
41. 
    
42.   Select Case strAln
    
43.     Case "A"
    
44.       Align = acAlignmentAligned
    
45.     Case "F"
    
46.       Align = acAlignmentFit
    
47.     Case "M"
    
48.       Align = acAlignmentMiddle
    
49.     Case "C"
    
50.       Align = acAlignmentCenter
    
51.     Case "R"
    
52.       Align = acAlignmentRight
    
53.     Case "TL"
    
54.       Align = acAlignmentTopLeft
    
55.     Case "TC"
    
56.       Align = acAlignmentTopCenter
    
57.     Case "TR"
    
58.       Align = acAlignmentTopRight
    
59.     Case "ML"
    
60.       Align = acAlignmentMiddleLeft
    
61.     Case "MC"
    
62.       Align = acAlignmentMiddleCenter
    
63.     Case "MR"
    
64.       Align = acAlignmentMiddleRight
    
65.     Case "BL"
    
66.       Align = acAlignmentBottomLeft
    
67.     Case "BC"
    
68.       Align = acAlignmentBottomCenter
    
69.     Case "BR"
    
70.       Align = acAlignmentBottomRight
    
71.     Case Else
    
72.       Align = acAlignmentLeft
    
73.   End Select
    
74.   insPt(0) = insX
    
75.   insPtpt(1) = insY
    
76.   insPtpt(2) = 0
    
77.   alnPt(0) = alnX
    
78.   alnPt(1) = alnY
    
79.   alnPt(2) = 0
    
80.   ThisDrawing.ActiveTextStyle = ThisDrawing.TextStyles.Item(strFont)
    
81.   Set textObj = ThisDrawing.PaperSpace.AddText(textString, insPt, height)
    
82.   textObj.Alignment = Align
    
83.   textObj.TextAlignmentPoint = alnPt
    
84. End Sub
    
85. 
    
86. '划线
    
87. Private Sub DrawLine(xFrom, yFrom, xTo, yTo As Double)
    
88.   Dim lineObj As AcadLine
    
89.   Dim ptFrom(0 To 2) As Double
    
90.   Dim ptTo(0 To 2) As Double
    
91.   
    
92.   ptFrom(0) = xFrom
    
93.   ptFrom(1) = yFrom
    
94.   ptFrom(2) = 0
    
95.   
    
96.   ptTo(0) = xTo
    
97.   ptTo(1) = yTo
    
98.   ptTo(2) = 0
    
99.   
    
100.   Set lineObj = ThisDrawing.PaperSpace.AddLine(ptFrom, ptTo)
     
101. End Sub
     
102. 
     
103. '打印Layout
     
104. Private Sub PlotLayout(LayoutName As String, bPlotToFile As Boolean)
     
105.   Dim strLayouts(1) As String
     
106.   Dim varLayouts As Variant
     
107.   Dim bSuccess As Boolean
     
108.   
     
109.   strLayouts(1) = LayoutName
     
110.   varLayouts = strLayouts
     
111.   
     
112.   ThisDrawing.Plot.SetLayoutsToPlot varLayouts
     
113.   If bPlotToFile Then
     
114.     MsgBox LayoutName + "打印到文件", vbExclamation, "打印提示"
     
115.   Else
     
116.     ThisDrawing.Plot.NumberOfCopies = 1
     
117.     bSuccess =
     
118. 
     
119. ThisDrawing.Plot.PlotToDevice(ThisDrawing.Application.Preferences.Output.DefaultOutputDevic
     
120. 
     
121. e)
     
122.   End If
     
123. End Sub
     
124. 
     
125. '删除布局
     
126. Private Sub DeleteLayout(LayoutName As String)
     
127.   ThisDrawing.Layouts.Item(LayoutName).Delete
     
128. End Sub
     
129. 
     
130. '图&文Layout
     
131. Private Sub NewGraphLayout(LayoutName As String)
     
132.   Dim TempLayout As AcadLayout
     
133.   Dim PVPort As AcadPViewport
     
134.   Dim pt(0 To 2) As Double
     
135.   
     
136.   Set TempLayout = ThisDrawing.Layouts.Add(LayoutName)
     
137.   TempLayout.CanonicalMediaName = "A4"
     
138.   TempLayout.PlotRotation = ac90degrees
     
139. 
     
140.   ThisDrawing.ActiveLayout = TempLayout
     
141.   ThisDrawing.ActiveSpace = acPaperSpace
     
142.   ThisDrawing.MSpace = False
     
143.   Set PVPort = ThisDrawing.PaperSpace.Item(1)
     
144.   pt(0) = 112
     
145.   pt(1) = 95
     
146.   pt(2) = 0
     
147.   PVPort.Center = pt
     
148.   PVPort.Width = 196
     
149.   PVPort.height = 160
     
150.   PVPort.Update
     
151. End sub
     
152. 
     
153. '画吧，写吧，打印它吧
     
154. Private Sub PrintFWFCHZB()
     
155.   Dim i As Integer
     
156.   
     
157.   Dim titleFont As String
     
158.   Dim textFont As String
     
159.   Dim dataFont As String
     
160.   dim strFWJZMJFCHZB as string
     
161.   
     
162.   strFWJZMJFCHZB = 'My Report'
     
163.   
     
164.   NewTextLayout strFWJZMJFCHZB, "A4", False
     
165.   
     
166.   titleFont = "黑体"
     
167.   textFont = "宋体"
     
168.   dataFont = "仿宋"
     
169.   
     
170.   For i = 0 To 25
     
171.     DrawLine 16, 50 + i * 8, 180, 50 + i * 8
     
172.   Next i
     
173.   DrawLine 16, 50, 16, 250
     
174.   DrawLine 40, 50, 40, 250
     
175.   DrawLine 80, 50, 80, 250
     
176.   DrawLine 180, 50, 180, 250
     
177.   DrawText "X X X X X X X X 汇 总 表", titleFont, 50, 260, 4
     
178.   DrawText "建筑物名称:", textFont, 18, 252, 3
     
179.   If strLMC <> "" Then
     
180.     DrawText strLMC, dataFont, 44, 252, 3
     
181.   End If
     
182.   DrawText "层  次", textFont, 22, 244.7, 2.6
     
183.   DrawText "建筑面积", textFont, 52, 244.7, 2.6
     
184.   DrawText "备  注", textFont, 124, 244.7, 2.6
     
185.   '....
     
186.   ThisDrawing.Regen acActiveViewport
     
187.   PlotLayout strFWJZMJFCHZB, False
     
188.   DeleteLayout strFWJZMJFCHZB
     
189. End Sub
     
190. 
     

<br /> '纯文本报表(生成一个无PViewport的Layout)<br /> Private Sub NewTextLayout(LayoutName, PaperSize As String, Rotate As Boolean)<br />   Dim TempLayout As AcadLayout<br />   <br />   Set TempLayout = ThisDrawing.Layouts.Add(LayoutName)<br />   TempLayout.CanonicalMediaName = PaperSize<br />   If Rotate Then<br />     TempLayout.PlotRotation = ac90degrees<br />   Else<br />     TempLayout.PlotRotation = ac0degrees<br />   End If<br />   ThisDrawing.ActiveLayout = TempLayout<br />   ThisDrawing.ActiveSpace = acPaperSpace<br />   ThisDrawing.MSpace = False<br />   '删除系统缺省添加的PViewPort<br />   ThisDrawing.PaperSpace.Item(1).Delete<br /> End Sub<br /> <br /> '写文字<br /> Private Sub DrawText(textString, strFont As String, X, Y, height As Double)<br />   Dim textObj As AcadText<br />   Dim pt(0 To 2) As Double<br />   <br />   pt(0) = X<br />   pt(1) = Y<br />   pt(2) = 0<br />   ThisDrawing.ActiveTextStyle = ThisDrawing.TextStyles.Item(strFont)<br />   Set textObj = ThisDrawing.PaperSpace.AddText(textString, pt, height)<br /> End Sub<br /> <br /> '写Align文字<br /> Private Sub DrawAlignText(textString, strFont As String, insX, insY, alnX, alnY, height As <br /> <br /> Double, strAln As String)<br />   Dim textObj As AcadText<br />   Dim insPt(0 To 2) As Double<br />   Dim alnPt(0 To 2) As Double<br />   Dim Align As AcAlignment<br /> <br />   Select Case strAln<br />     Case "A"<br />       Align = acAlignmentAligned<br />     Case "F"<br />       Align = acAlignmentFit<br />     Case "M"<br />       Align = acAlignmentMiddle<br />     Case "C"<br />       Align = acAlignmentCenter<br />     Case "R"<br />       Align = acAlignmentRight<br />     Case "TL"<br />       Align = acAlignmentTopLeft<br />     Case "TC"<br />       Align = acAlignmentTopCenter<br />     Case "TR"<br />       Align = acAlignmentTopRight<br />     Case "ML"<br />       Align = acAlignmentMiddleLeft<br />     Case "MC"<br />       Align = acAlignmentMiddleCenter<br />     Case "MR"<br />       Align = acAlignmentMiddleRight<br />     Case "BL"<br />       Align = acAlignmentBottomLeft<br />     Case "BC"<br />       Align = acAlignmentBottomCenter<br />     Case "BR"<br />       Align = acAlignmentBottomRight<br />     Case Else<br />       Align = acAlignmentLeft<br />   End Select<br />   insPt(0) = insX<br />   insPtpt(1) = insY<br />   insPtpt(2) = 0<br />   alnPt(0) = alnX<br />   alnPt(1) = alnY<br />   alnPt(2) = 0<br />   ThisDrawing.ActiveTextStyle = ThisDrawing.TextStyles.Item(strFont)<br />   Set textObj = ThisDrawing.PaperSpace.AddText(textString, insPt, height)<br />   textObj.Alignment = Align<br />   textObj.TextAlignmentPoint = alnPt<br /> End Sub<br /> <br /> '划线<br /> Private Sub DrawLine(xFrom, yFrom, xTo, yTo As Double)<br />   Dim lineObj As AcadLine<br />   Dim ptFrom(0 To 2) As Double<br />   Dim ptTo(0 To 2) As Double<br />   <br />   ptFrom(0) = xFrom<br />   ptFrom(1) = yFrom<br />   ptFrom(2) = 0<br />   <br />   ptTo(0) = xTo<br />   ptTo(1) = yTo<br />   ptTo(2) = 0<br />   <br />   Set lineObj = ThisDrawing.PaperSpace.AddLine(ptFrom, ptTo)<br /> End Sub<br /> <br /> '打印Layout<br /> Private Sub PlotLayout(LayoutName As String, bPlotToFile As Boolean)<br />   Dim strLayouts(1) As String<br />   Dim varLayouts As Variant<br />   Dim bSuccess As Boolean<br />   <br />   strLayouts(1) = LayoutName<br />   varLayouts = strLayouts<br />   <br />   ThisDrawing.Plot.SetLayoutsToPlot varLayouts<br />   If bPlotToFile Then<br />     MsgBox LayoutName + "打印到文件", vbExclamation, "打印提示"<br />   Else<br />     ThisDrawing.Plot.NumberOfCopies = 1<br />     bSuccess = <br /> <br /> ThisDrawing.Plot.PlotToDevice(ThisDrawing.Application.Preferences.Output.DefaultOutputDevic<br /> <br /> e)<br />   End If<br /> End Sub<br /> <br /> '删除布局<br /> Private Sub DeleteLayout(LayoutName As String)<br />   ThisDrawing.Layouts.Item(LayoutName).Delete<br /> End Sub<br /> <br /> '图&文Layout<br /> Private Sub NewGraphLayout(LayoutName As String)<br />   Dim TempLayout As AcadLayout<br />   Dim PVPort As AcadPViewport<br />   Dim pt(0 To 2) As Double<br />   <br />   Set TempLayout = ThisDrawing.Layouts.Add(LayoutName)<br />   TempLayout.CanonicalMediaName = "A4"<br />   TempLayout.PlotRotation = ac90degrees<br /> <br />   ThisDrawing.ActiveLayout = TempLayout<br />   ThisDrawing.ActiveSpace = acPaperSpace<br />   ThisDrawing.MSpace = False<br />   Set PVPort = ThisDrawing.PaperSpace.Item(1)<br />   pt(0) = 112<br />   pt(1) = 95<br />   pt(2) = 0<br />   PVPort.Center = pt<br />   PVPort.Width = 196<br />   PVPort.height = 160<br />   PVPort.Update<br /> End sub<br /> <br /> '画吧，写吧，打印它吧<br /> Private Sub PrintFWFCHZB()<br />   Dim i As Integer<br />   <br />   Dim titleFont As String<br />   Dim textFont As String<br />   Dim dataFont As String<br />   dim strFWJZMJFCHZB as string<br />   <br />   strFWJZMJFCHZB = 'My Report'<br />   <br />   NewTextLayout strFWJZMJFCHZB, "A4", False<br />   <br />   titleFont = "黑体"<br />   textFont = "宋体"<br />   dataFont = "仿宋"<br />   <br />   For i = 0 To 25<br />     DrawLine 16, 50 + i * 8, 180, 50 + i * 8<br />   Next i<br />   DrawLine 16, 50, 16, 250<br />   DrawLine 40, 50, 40, 250<br />   DrawLine 80, 50, 80, 250<br />   DrawLine 180, 50, 180, 250<br />   DrawText "X X X X X X X X 汇 总 表", titleFont, 50, 260, 4<br />   DrawText "建筑物名称:", textFont, 18, 252, 3<br />   If strLMC <> "" Then<br />     DrawText strLMC, dataFont, 44, 252, 3<br />   End If<br />   DrawText "层  次", textFont, 22, 244.7, 2.6<br />   DrawText "建筑面积", textFont, 52, 244.7, 2.6<br />   DrawText "备  注", textFont, 124, 244.7, 2.6<br />   '....<br />   ThisDrawing.Regen acActiveViewport<br />   PlotLayout strFWJZMJFCHZB, False<br />   DeleteLayout strFWJZMJFCHZB<br /> End Sub<br /> <br />

方便吧，一切尽在掌握中。
去实现你自己图文并茂的报表生成器吧!