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
<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関数：属性の値をｎ個取得して、リストで返す
'' 引数 ："ブロック名" "属性名１" "属性名２" ...
'' 戻り値 :("属性文字１" "属性文字２" ....)
'' :ブロック名が存在しないときは、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
'' 文字列２個以上（属性１個以上）
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