Bricscad .NET VB サンプル

■アクティブな図面と同じフォルダのDWGファイルを読む (2015/ 5/ 8)
 ※CAD上には、読み込まれない

        <CommandMethod("DirDwgnames", CommandFlags.Modal)> _
        Public Shared Sub CmdDwgNamesEx()
            Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
            Dim doc As Document
            '' 現在アクティブなドキュメントを取得
            doc = Application.DocumentManager.MdiActiveDocument
            '' ファイル名からフォルダ名を取得
            Dim dwgdir As String = System.IO.Path.GetDirectoryName(doc.Name)
            ed.WriteMessage(vbCrLf + dwgdir)
            If dwgdir <> "" Then
                Dim dwgnames() As String
                '' 同じフォルダ内のDWGファイル名を取得
                dwgnames = Directory.GetFiles(dwgdir, "*.dwg", System.IO.SearchOption.AllDirectories)

                Dim dwgname As String
                '' ファイルを順に開く
                For Each dwgname In dwgnames
                    Using db As Database = New Database(False, True)
                        Try
                            '' ファイルを開く
                            db.ReadDwgFile(dwgname, FileShare.Read, True, Nothing)
                            ed.WriteMessage(vbCrLf + db.Filename)
                        Catch ex As Exception
                            '' 編集中の場合は、eCantOpenFile エラーになる
                            ed.WriteMessage(vbCrLf + "エラー: " + dwgname + ":" + ex.Message)
                        End Try
                    End Using
                Next
            End If
        End Sub

■編集中のすべての図面の取得する (2015/ 5/ 8)
        <CommandMethod("dwgnames", CommandFlags.Modal)> _
        Public Shared Sub CmdDwgNames()
            Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
            Dim doc As Document
            Dim lmax As Point2d
            Dim lmin As Point2d

            For Each doc In Application.DocumentManager
                '' ファイル名(フルパス)保存されていないときは、ファイル名のみ
                ed.WriteMessage(vbCrLf + doc.Name)
                '' データベースを取得
                Using db As Database = doc.Database
                    lmax = db.Limmax
                    lmin = db.Limmin
                    ed.WriteMessage(vbCrLf + "LIMMAX=" + lmax(0).ToString() + "," + lmax(1).ToString())
                    ed.WriteMessage(vbCrLf + "LIMMIN=" + lmin(0).ToString() + "," + lmin(1).ToString())
                    ed.WriteMessage(vbCrLf + "DIMSCALE=" + db.Dimscale.ToString())
                    '' 保存されていないときは ""、その他はフルパス
                    ed.WriteMessage(vbCrLf + "FILENAME=" + db.Filename)
                End Using
            Next
        End Sub


■アクティブな図面の属性を取得する LISP 関数 (2015/ 5/ 8)


        '' LISP関数:属性の値をn個取得して、リストで返す
        '' 引数 :"ブロック名" "属性名1" "属性名2" ...
        '' 戻り値 :("属性文字1" "属性文字2" ....)
        ''    :ブロック名が存在しないときは、nil
        '' 例:(GetAttString "TITLE" "ZSHEET" "ZITEM9" "ZITEM8") 戻り値:("123" "21" "23")
        ''
        <LispFunction("GetAttString")> _
        Public Shared Function FuncGetAttString(ByVal rbArgs As ResultBuffer) As ResultBuffer

            '' LISPに返す戻り値の初期値 = nil
            Dim rbResult As ResultBuffer = New ResultBuffer(New TypedValue(LispDataType.Nil))

            Dim BlkName As String = ""
            Dim TagName() As String
            Dim TagString() As String
            Dim cnt As Integer
            Dim i As Integer

            '' LISP関数の引数の数とタイプをチェック
            Dim tvArr As TypedValue() = rbArgs.AsArray()
            cnt = 0
            If tvArr.Count >= 2 Then
                cnt = tvArr.Count - 1
                ReDim TagName(tvArr.Count - 2)
                ReDim TagString(tvArr.Count - 2)
                For i = 0 To tvArr.Count - 1
                    '' 最初の文字が、ブロック名
                    If i = 0 Then
                        If tvArr(0).TypeCode = LispDataType.Text Then BlkName = tvArr(0).Value Else BlkName = ""
                        '' それ以降は、属性のタグ名
                    Else
                        If tvArr(i).TypeCode = LispDataType.Text Then TagName(i - 1) = tvArr(i).Value Else TagName(i - 1) = ""
                    End If
                    '' 初期化
                    TagString(i - 1) = ""
                Next
                '' 文字列2個以上(属性1個以上)
                If BlkName <> "" And cnt > 0 Then
                    '' 編集中の図面のデータベースを取得
                    Using db As Database = Application.DocumentManager.MdiActiveDocument.Database
                        '' トラザクションの開始
                        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 objId As ObjectId
                                Dim entityObj As Entity
                                Dim blkRefObj As BlockReference
                                Dim attCollction As AttributeCollection
                                Dim Flag As Boolean = False
                                Dim n As Integer = 0

                                For Each objId In btr
                                    '' オブジェクトIDからエンティティを取得
                                    entityObj = trans.GetObject(objId, OpenMode.ForRead, False, True)
                                    '' ブロックであれば・・・
                                    If TypeOf entityObj Is BlockReference Then
                                        blkRefObj = CType(entityObj, BlockReference)
                                        '' 属性コレクションを取得
                                        attCollction = blkRefObj.AttributeCollection
                                        '' 属性が有れば・・・
                                        If attCollction.Count > 0 Then
                                            Dim attObjId As ObjectId
                                            Dim attObjEntity As Entity
                                            Dim attRef As AttributeReference
                                            '' ブロック名の確認
                                            If blkRefObj.Name = BlkName Then
                                                For Each attObjId In attCollction
                                                    attObjEntity = trans.GetObject(attObjId, OpenMode.ForRead, False, True)
                                                    '' 属性を確認
                                                    If TypeOf attObjEntity Is AttributeReference Then
                                                        attRef = CType(attObjEntity, AttributeReference)
                                                        For i = 0 To cnt - 1
                                                            '' 属性名を確認
                                                            If attRef.Tag = TagName(i) Then
                                                                TagString(i) = attRef.TextString
                                                                n = n + 1
                                                                If n = cnt Then
                                                                    '' 検索終了
                                                                    Flag = True
                                                                    Exit For
                                                                End If
                                                            End If
                                                        Next
                                                    End If
                                                Next
                                            End If
                                        End If
                                    End If
                                    If Flag Then Exit For
                                Next

                            Catch ex As Exception
                                Application.ShowAlertDialog("エラー GetAttStringEx : " + ex.Message)
                            End Try
                        End Using
                    End Using
                    '' レザルトバッファを破棄
                    rbResult.Dispose()
                    '' レザルトバッファのLISTを作成 ex:("TEXT1" "TEXT2" TEXT3")
                    rbResult = New ResultBuffer(New TypedValue(LispDataType.ListBegin))
                    For i = 0 To cnt - 1
                        rbResult.Add(New TypedValue(LispDataType.Text, TagString(i)))
                    Next
                    rbResult.Add(New TypedValue(LispDataType.ListEnd))
                End If
            End If

            Return rbResult
        End Function