[VBA程序]：一个版面打印多张图纸

rockes

我写的打印程序
不过还有很多bug。主要考虑到当时的时间太紧张了，后来又不想动了。不过如果院里的图没有被改动的话是没有问题的。真诚的希望有朋友能够将其修改为更好使用的程序

Sub drawingplot()
'本程序完成于2002.10.8
'

' 创建新的选择集
  
  Dim sset As AcadSelectionSet
  
  '定义可以储存的直线常数
  Const counts As Integer = 100
  
  On Error Resume Next
  ThisDrawing.SelectionSets.Item("SS1").Delete
  
  Set sset = ThisDrawing.SelectionSets.Add("SS1")

  Dim FilterType As Variant, FilterData As Variant
  Dim gpCode(3) As Integer, datavalue(3) As Variant

  '创建过滤器
  '本例为过滤直线或图层为Defpionts
  '使用的是变体数组进行定义

  '分组运算符
  gpCode(0) = -4
  datavalue(0) = "<and"

  '直线过滤器
  gpCode(1) = 0
  datavalue(1) = "LINE"

  '圆弧过滤器
  gpCode(2) = 8
  datavalue(2) = "DEFPOINTS"


  '分组运算符
  gpCode(3) = -4
  datavalue(3) = "and>"

  FilterType = gpCode
  FilterData = datavalue

  ' 添加至选择集中，在选择过程中进行过滤
  ' 完成选择后按回车。
  sset.SelectOnScreen FilterType, FilterData

  ' 在选择集中循环并将每一已合条件的对象颜色更改为蓝色。
  'Dim entry As AcadEntity
  Dim entry As AcadLine

'定义储存末端与起点的坐标。

Dim sstart(counts) As Variant
Dim eend(counts) As Variant

Dim ccount As Integer

ccount = 0

  For Each entry In sset
  
    sstart(ccount) = entry.StartPoint
    eend(ccount) = entry.EndPoint
   
    ccount = ccount + 1
   
Next entry
Dim scount As Integer
scount = sset.Count - 1
'定义临时的起始点和末端点
Dim tempendlowleft As Variant
Dim tempendupright As Variant
Dim temp As Variant

'定义循环计数器
Dim i As Integer
Dim j As Integer
For i = 0 To scount
For j = i To scount
If ((sstart(i)(0) = sstart(j)(0)) And (sstart(i)(1) = sstart(j)(1)) And (i <> j)) Then

tempendlowleft = eend(i)
tempendupright = eend(j)
'定义改变成每一个的左下角以及右上角

If (tempendlowleft(0) > tempendupright(0)) Then
temp = tempendlowleft
tempendlowleft = tempendupright
tempendupright = temp

End If

'定义为当前的layout
Dim tempendlowleft1(0 To 1) As Double

Dim tempendupright1(0 To 1) As Double
tempendlowleft1(0) = tempendlowleft(0)
tempendlowleft1(1) = tempendlowleft(1)
tempendupright1(0) = tempendupright(0)
tempendupright1(1) = tempendupright(1)

ThisDrawing.ActiveLayout.SetWindowToPlot tempendlowleft1, tempendupright1

    ThisDrawing.ActiveLayout.PlotType = acWindow
   
     ThisDrawing.Plot.PlotToDevice


End If
Next j
  
Next i

End Sub

千年雪域

好东东！！

wwwdh

能否用vba编个批量处理多张图纸的程序，依次打开每个文件，运行相同的命令