找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1246|回复: 0

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

[复制链接]
发表于 2002-1-31 18:22:29 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

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


  1. '纯文本报表(生成一个无PViewport的Layout)
  2. Private Sub NewTextLayout(LayoutName, PaperSize As String, Rotate As Boolean)
  3.   Dim TempLayout As AcadLayout
  4.   
  5.   Set TempLayout = ThisDrawing.Layouts.Add(LayoutName)
  6.   TempLayout.CanonicalMediaName = PaperSize
  7.   If Rotate Then
  8.     TempLayout.PlotRotation = ac90degrees
  9.   Else
  10.     TempLayout.PlotRotation = ac0degrees
  11.   End If
  12.   ThisDrawing.ActiveLayout = TempLayout
  13.   ThisDrawing.ActiveSpace = acPaperSpace
  14.   ThisDrawing.MSpace = False
  15.   '删除系统缺省添加的PViewPort
  16.   ThisDrawing.PaperSpace.Item(1).Delete
  17. End Sub

  18. '写文字
  19. Private Sub DrawText(textString, strFont As String, X, Y, height As Double)
  20.   Dim textObj As AcadText
  21.   Dim pt(0 To 2) As Double
  22.   
  23.   pt(0) = X
  24.   pt(1) = Y
  25.   pt(2) = 0
  26.   ThisDrawing.ActiveTextStyle = ThisDrawing.TextStyles.Item(strFont)
  27.   Set textObj = ThisDrawing.PaperSpace.AddText(textString, pt, height)
  28. End Sub

  29. '写Align文字
  30. Private Sub DrawAlignText(textString, strFont As String, insX, insY, alnX, alnY, height As

  31. Double, strAln As String)
  32.   Dim textObj As AcadText
  33.   Dim insPt(0 To 2) As Double
  34.   Dim alnPt(0 To 2) As Double
  35.   Dim Align As AcAlignment

  36.   Select Case strAln
  37.     Case "A"
  38.       Align = acAlignmentAligned
  39.     Case "F"
  40.       Align = acAlignmentFit
  41.     Case "M"
  42.       Align = acAlignmentMiddle
  43.     Case "C"
  44.       Align = acAlignmentCenter
  45.     Case "R"
  46.       Align = acAlignmentRight
  47.     Case "TL"
  48.       Align = acAlignmentTopLeft
  49.     Case "TC"
  50.       Align = acAlignmentTopCenter
  51.     Case "TR"
  52.       Align = acAlignmentTopRight
  53.     Case "ML"
  54.       Align = acAlignmentMiddleLeft
  55.     Case "MC"
  56.       Align = acAlignmentMiddleCenter
  57.     Case "MR"
  58.       Align = acAlignmentMiddleRight
  59.     Case "BL"
  60.       Align = acAlignmentBottomLeft
  61.     Case "BC"
  62.       Align = acAlignmentBottomCenter
  63.     Case "BR"
  64.       Align = acAlignmentBottomRight
  65.     Case Else
  66.       Align = acAlignmentLeft
  67.   End Select
  68.   insPt(0) = insX
  69.   insPtpt(1) = insY
  70.   insPtpt(2) = 0
  71.   alnPt(0) = alnX
  72.   alnPt(1) = alnY
  73.   alnPt(2) = 0
  74.   ThisDrawing.ActiveTextStyle = ThisDrawing.TextStyles.Item(strFont)
  75.   Set textObj = ThisDrawing.PaperSpace.AddText(textString, insPt, height)
  76.   textObj.Alignment = Align
  77.   textObj.TextAlignmentPoint = alnPt
  78. End Sub

  79. '划线
  80. Private Sub DrawLine(xFrom, yFrom, xTo, yTo As Double)
  81.   Dim lineObj As AcadLine
  82.   Dim ptFrom(0 To 2) As Double
  83.   Dim ptTo(0 To 2) As Double
  84.   
  85.   ptFrom(0) = xFrom
  86.   ptFrom(1) = yFrom
  87.   ptFrom(2) = 0
  88.   
  89.   ptTo(0) = xTo
  90.   ptTo(1) = yTo
  91.   ptTo(2) = 0
  92.   
  93.   Set lineObj = ThisDrawing.PaperSpace.AddLine(ptFrom, ptTo)
  94. End Sub

  95. '打印Layout
  96. Private Sub PlotLayout(LayoutName As String, bPlotToFile As Boolean)
  97.   Dim strLayouts(1) As String
  98.   Dim varLayouts As Variant
  99.   Dim bSuccess As Boolean
  100.   
  101.   strLayouts(1) = LayoutName
  102.   varLayouts = strLayouts
  103.   
  104.   ThisDrawing.Plot.SetLayoutsToPlot varLayouts
  105.   If bPlotToFile Then
  106.     MsgBox LayoutName + "打印到文件", vbExclamation, "打印提示"
  107.   Else
  108.     ThisDrawing.Plot.NumberOfCopies = 1
  109.     bSuccess =

  110. ThisDrawing.Plot.PlotToDevice(ThisDrawing.Application.Preferences.Output.DefaultOutputDevic

  111. e)
  112.   End If
  113. End Sub

  114. '删除布局
  115. Private Sub DeleteLayout(LayoutName As String)
  116.   ThisDrawing.Layouts.Item(LayoutName).Delete
  117. End Sub

  118. '图&文Layout
  119. Private Sub NewGraphLayout(LayoutName As String)
  120.   Dim TempLayout As AcadLayout
  121.   Dim PVPort As AcadPViewport
  122.   Dim pt(0 To 2) As Double
  123.   
  124.   Set TempLayout = ThisDrawing.Layouts.Add(LayoutName)
  125.   TempLayout.CanonicalMediaName = "A4"
  126.   TempLayout.PlotRotation = ac90degrees

  127.   ThisDrawing.ActiveLayout = TempLayout
  128.   ThisDrawing.ActiveSpace = acPaperSpace
  129.   ThisDrawing.MSpace = False
  130.   Set PVPort = ThisDrawing.PaperSpace.Item(1)
  131.   pt(0) = 112
  132.   pt(1) = 95
  133.   pt(2) = 0
  134.   PVPort.Center = pt
  135.   PVPort.Width = 196
  136.   PVPort.height = 160
  137.   PVPort.Update
  138. End sub

  139. '画吧,写吧,打印它吧
  140. Private Sub PrintFWFCHZB()
  141.   Dim i As Integer
  142.   
  143.   Dim titleFont As String
  144.   Dim textFont As String
  145.   Dim dataFont As String
  146.   dim strFWJZMJFCHZB as string
  147.   
  148.   strFWJZMJFCHZB = 'My Report'
  149.   
  150.   NewTextLayout strFWJZMJFCHZB, "A4", False
  151.   
  152.   titleFont = "黑体"
  153.   textFont = "宋体"
  154.   dataFont = "仿宋"
  155.   
  156.   For i = 0 To 25
  157.     DrawLine 16, 50 + i * 8, 180, 50 + i * 8
  158.   Next i
  159.   DrawLine 16, 50, 16, 250
  160.   DrawLine 40, 50, 40, 250
  161.   DrawLine 80, 50, 80, 250
  162.   DrawLine 180, 50, 180, 250
  163.   DrawText "X X X X X X X X 汇 总 表", titleFont, 50, 260, 4
  164.   DrawText "建筑物名称:", textFont, 18, 252, 3
  165.   If strLMC <> "" Then
  166.     DrawText strLMC, dataFont, 44, 252, 3
  167.   End If
  168.   DrawText "层  次", textFont, 22, 244.7, 2.6
  169.   DrawText "建筑面积", textFont, 52, 244.7, 2.6
  170.   DrawText "备  注", textFont, 124, 244.7, 2.6
  171.   '....
  172.   ThisDrawing.Regen acActiveViewport
  173.   PlotLayout strFWJZMJFCHZB, False
  174.   DeleteLayout strFWJZMJFCHZB
  175. End Sub



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

本帖被以下淘专辑推荐:

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-3-29 18:19 , Processed in 0.341613 second(s), 33 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表