現在開いている図面のうち、アクティブな図面のフォルダ名と同じ図面を連続で印刷します。
印刷尺度は、DIMSCALEからA3基準で計算されます。
印刷範囲は、図面範囲（LIMMAX-LIMMIN)のみ。
図枠のブロックに含まれる属性からシート番号を取得し、その順で一覧表示されます。
図面一覧をクリックすると、DWGプレビューイメージが表示されます。
■ソースコード（フォーム関連のみ）
Bricscad VB.NET 連続印刷サンプル MDPLot.dll
■概要
現在開いている図面のうち、アクティブな図面のフォルダ名と同じ図面を連続で印刷します。
印刷尺度は、DIMSCALEからA3基準で計算されます。
印刷範囲は、図面範囲（LIMMAX-LIMMIN)のみ。
図枠のブロックに含まれる属性からシート番号を取得し、その順で一覧表示されます。
図面一覧をクリックすると、DWGプレビューイメージが表示されます。
■ソースコード（フォーム関連のみ）
// ここにコードを書く
' system
Imports System.Text
Imports System.Runtime.InteropServices
Imports System.IO
Imports System.Drawing.Printing
Imports System.Drawing.Printing.PrinterSettings
' ODA
Imports Teigha.Runtime
Imports Teigha.DatabaseServices
Imports Teigha.Geometry
' Bricsys
Imports Bricscad.ApplicationServices
Imports Bricscad.Runtime
Imports Bricscad.EditorInput
Imports Bricscad.PlottingServices
' com
Imports BricscadDb
Imports BricscadApp
' alias
Imports _AcRx = Teigha.Runtime
Imports _AcAp = Bricscad.ApplicationServices
Imports _AcDb = Teigha.DatabaseServices
Imports _AcGe = Teigha.Geometry
Imports _AcEd = Bricscad.EditorInput
Imports _AcGi = Teigha.GraphicsInterface
Imports _AcClr = Teigha.Colors
Imports _AcWnd = Bricscad.Windows
Public Class Form1
'' データ保持用構造体
Structure DwgRecord
Dim DwgName As String
Dim DwgPrefix As String
Dim DocIndex As Integer
Dim DimScale As Double
Dim SheetNo As String
Dim PageNo As String
Dim Bmp As Drawing.Bitmap
End Structure
Public Shared DwgRecAry() As DwgRecord
Public Shared Sub GetDwgRecProps(ByRef Doc As Document, _
ByRef DimScale As Double, ByRef SheetNo As String, ByRef PageNo As String, ByRef bmp As Drawing.Bitmap)
Const BlkName As String = "TITLE"
Const TagName1 As String = "ZSHEET"
Const TagName2 As String = "ZITEM9"
Using db As Database = Doc.Database
'' システム変数を取得
DimScale = db.Dimscale
bmp = New Drawing.Bitmap(db.ThumbnailBitmap)
'' トラザクションの開始
Using trans As Transaction = db.TransactionManager.StartTransaction()
Try
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
'' モデルの図形テーブルレコード
Dim btr As BlockTableRecord = trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForRead)
Dim Flag1 As Boolean = False
Dim Flag2 As Boolean = False
For Each objId As ObjectId In btr
'' オブジェクトIDからエンティティを取得
Dim entityObj As Entity = trans.GetObject(objId, OpenMode.ForRead, False, True)
'' ブロックであれば・・・
If TypeOf entityObj Is BlockReference Then
Dim blkRefObj As BlockReference = CType(entityObj, BlockReference)
'' 属性コレクションを取得
Dim attCollction As AttributeCollection = blkRefObj.AttributeCollection
'' 属性が有れば・・・
If attCollction.Count > 0 Then
'' ブロック名の確認
If blkRefObj.Name = BlkName Then
For Each attObjId As ObjectId In attCollction
Dim attObjEntity As Entity = trans.GetObject(attObjId, OpenMode.ForRead, False, True)
'' 属性を確認
If TypeOf attObjEntity Is AttributeReference Then
Dim attRef As AttributeReference = CType(attObjEntity, AttributeReference)
'' 属性名を確認
If attRef.Tag = TagName1 Then
SheetNo = attRef.TextString
Flag1 = True
ElseIf attRef.Tag = TagName2 Then
PageNo = attRef.TextString
Flag2 = True
End If
End If
If Flag1 And Flag2 Then Exit For
Next
End If
End If
End If
If Flag1 And Flag2 Then Exit For
Next
Catch ex As Exception
'Application.ShowAlertDialog("エラー GetAttStringEx : " + ex.Message)
End Try
End Using
End Using
End Sub
Public Shared Sub SortDwgRecsSheetNo(pageSort As Boolean)
Dim temp As DwgRecord
Dim s As String
Dim s1 As String
Dim n As Integer = 0
For i As Integer = 0 To UBound(DwgRecAry)
If pageSort Then
If n < DwgRecAry(i).PageNo.Length Then n = DwgRecAry(i).PageNo.Length
End If
Next
If UBound(DwgRecAry) > 0 Then
For i As Integer = 0 To UBound(DwgRecAry) - 1
If pageSort Then
s = Microsoft.VisualBasic.Right("0000" + DwgRecAry(i).PageNo, n)
Else
s = DwgRecAry(i).SheetNo
End If
For j As Integer = i + 1 To UBound(DwgRecAry)
If pageSort Then
s1 = Microsoft.VisualBasic.Right("0000" + DwgRecAry(j).PageNo, n)
Else
s1 = DwgRecAry(j).SheetNo
End If
If s > s1 Then
temp = DwgRecAry(i) : DwgRecAry(i) = DwgRecAry(j) : DwgRecAry(j) = temp
s = s1
End If
Next
Next
End If
End Sub
Public Shared Sub GetDwgRecs(ByRef dwgrecs() As DwgRecord)
'' 現在の図面のフォルダ名を取得
Dim prefix As String = IO.Path.GetDirectoryName(Application.DocumentManager.MdiActiveDocument.Name)
'' 必要な配列数を取得
Dim n As Integer = 0
For i As Integer = 0 To Application.DocumentManager.Count - 1
Dim s As String = IO.Path.GetDirectoryName(Application.DocumentManager(i).Name)
'' フォルダ名が同じ
If s <> "" And s = prefix Then n += 1
Next
'' 配列を確保（添え字の上限）
ReDim dwgrecs(n - 1)
Dim cnt As Integer = 0
For i As Integer = 0 To Application.DocumentManager.Count - 1
Dim s As String = IO.Path.GetDirectoryName(Application.DocumentManager(i).Name)
If s <> "" And s = prefix Then
Dim doc As Document = Application.DocumentManager(i)
With dwgrecs(cnt)
.DwgName = IO.Path.GetFileName(doc.Name)
.DwgPrefix = IO.Path.GetDirectoryName(doc.Name)
'' DocManager でのインデックス
.DocIndex = i
'' 初期化
.DimScale = 1.0
.SheetNo = ""
.PageNo = ""
GetDwgRecProps(doc, .DimScale, .SheetNo, .PageNo, .Bmp)
End With
cnt += 1
End If
Next
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'' ファイル名を取得
GetDwgRecs(DwgRecAry)
'' SheetNo 順にソート
SortDwgRecsSheetNo(False)
'' 取得したファイル名をリストボックスに追加
For i As Integer = 0 To UBound(DwgRecAry)
CheckedListBox1.Items.Add(DwgRecAry(i).SheetNo + ":" + DwgRecAry(i).DwgName)
Next
'' プリンター一覧取得
For Each s As String In PrinterSettings.InstalledPrinters
ComboBox1.Items.Add(s)
Next
'' PrintDocumentの作成
Dim PrintDoc As New PrintDocument
'' デフォルトプリンタ名の取得
Dim defaultPrinterName As String = PrintDoc.PrinterSettings.PrinterName
'' デフォルトプリンタを表示
ComboBox1.SelectedIndex = ComboBox1.Items.IndexOf(defaultPrinterName)
'' デフォルトプリンターの用紙サイズを取得する
'' かなり時間がかかる
For Each ps As PaperSize In PrintDoc.PrinterSettings.PaperSizes
ComboBox2.Items.Add(ps.PaperName)
Next
'' デフォルトの用紙サイズ名に
ComboBox2.SelectedIndex = _
ComboBox2.Items.IndexOf(PrintDoc.PrinterSettings.DefaultPageSettings.PaperSize.PaperName)
'' Bricscad PlotStyle(ctb,stb)
For Each plotStyle As String In PlotSettingsValidator.Current.GetPlotStyleSheetList()
ComboBox3.Items.Add(plotStyle)
Next
ComboBox3.SelectedIndex = ComboBox3.Items.IndexOf("monochrome018.ctb")
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
'' 印刷
Dim PrnName As String = ComboBox1.SelectedItem
Dim PprName As String = ComboBox2.SelectedItem
Dim CtbName As String = ComboBox3.SelectedItem
With ProgressBar1
.Minimum = 0
.Maximum = CheckedListBox1.Items.Count
.Step = 1
End With
For i As Integer = 0 To CheckedListBox1.Items.Count - 1
If CheckedListBox1.GetItemChecked(i) Then
Dim docidx As Integer = DwgRecAry(i).DocIndex
If docidx >= 0 Then
Dim prScale As Double = DwgRecAry(i).DimScale
If PprName.IndexOf("A4") >= 0 Then prScale *= 1.414
'' ドキュメントを取得
Dim doc As Document = Application.DocumentManager(docidx)
'' アクティブなドキュメントを切り替える
'' すでにアクティブなときはそのまま（重要）
If Application.DocumentManager.MdiActiveDocument <> doc Then
Application.DocumentManager.MdiActiveDocument = doc
Application.UpdateScreen()
End If
Dim app As IAcadApplication = Application.AcadApplication
Dim appDoc As IAcadDocument = app.ActiveDocument
If appDoc.PlotConfigurations.Count = 0 Then appDoc.PlotConfigurations.Add("TEST", 0)
If appDoc.PlotConfigurations.Count > 0 Then
Dim cfg As IAcadPlotConfiguration = appDoc.PlotConfigurations.Item(0)
cfg.RefreshPlotDeviceInfo()
cfg.ConfigName = PrnName
cfg.CanonicalMediaName = PprName
cfg.StyleSheet = CtbName
cfg.PlotType = AcPlotType.acLimits
cfg.CenterPlot = True
cfg.UseStandardScale = False
cfg.PaperUnits = AcPlotPaperUnits.acMillimeters
cfg.PlotHidden = False
cfg.PlotWithPlotStyles = True
cfg.SetCustomScale(1.0, prScale)
cfg.PlotRotation = AcPlotRotation.ac0degrees
cfg.RefreshPlotDeviceInfo()
appDoc.Plot.PlotToDevice(cfg.ConfigName)
cfg = Nothing
End If
appDoc = Nothing
app = Nothing
End If
End If
ProgressBar1.PerformStep()
System.Windows.Forms.Application.DoEvents()
Next
ProgressBar1.Value = 0
End Sub
Private Sub CheckedListBox1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles CheckedListBox1.SelectedIndexChanged
PictureBox1.Image = DwgRecAry(CheckedListBox1.SelectedIndex).Bmp
DispCeckedCount()
End Sub
Private Sub ComboBox1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ComboBox1.SelectedIndexChanged
Dim PrintDoc As New PrintDocument
'' デフォルトプリンタを変更
PrintDoc.PrinterSettings.PrinterName = ComboBox1.SelectedItem
'' デフォルトプリンターの用紙サイズを取得する
'' かなり時間がかかる
ComboBox2.Items.Clear()
For Each ps As PaperSize In PrintDoc.PrinterSettings.PaperSizes
ComboBox2.Items.Add(ps.PaperName)
Next
'' デフォルトの用紙サイズ名に
ComboBox2.SelectedIndex = _
ComboBox2.Items.IndexOf(PrintDoc.PrinterSettings.DefaultPageSettings.PaperSize.PaperName)
End Sub
Public Sub DispCeckedCount()
Dim cnt As Integer = 0
With CheckedListBox1
For i As Integer = 0 To .Items.Count - 1
If .GetItemChecked(i) Then cnt += 1
Next
Label1.Text = cnt.ToString + "/" + .Items.Count.ToString
End With
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
'' すべてON
With CheckedListBox1
For i As Integer = 0 To .Items.Count - 1
.SetItemChecked(i, True)
Next
End With
DispCeckedCount()
End Sub
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
'' すべてON
With CheckedListBox1
For i As Integer = 0 To .Items.Count - 1
.SetItemChecked(i, False)
Next
End With
DispCeckedCount()
End Sub
End Class