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