<CommandMethod("SelectBlockRef")> _
Public Sub SelectBlockRef()
On Error Resume Next
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Dim acEditor As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
Dim prEnt As PromptEntityOptions = New PromptEntityOptions("选择一个对象:")
Dim prEntRes As PromptEntityResult = acEditor.GetEntity(prEnt)
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
Dim Obj As Object = acTrans.GetObject(prEntRes.ObjectId, OpenMode.ForRead)
MsgBox(Obj.GetType.ToString) '返回对象类型
Dim ObjFullName As String = Obj.GetType.FullName
Dim ObjName As String = ObjFullName.Substring(InStrRev(ObjFullName, "."))
If ObjName = "BlockReference" Then
Dim BlockRef As BlockReference = Obj
Dim BlockRecord As BlockTableRecord
BlockRecord = acTrans.GetObject(BlockRef.BlockTableRecord, _
OpenMode.ForRead)
'这才得到参照块的名称
'MsgBox(BlockRecord.Name)
'过滤条件
Dim acTypValAr(0) As TypedValue
acTypValAr.SetValue(New TypedValue(DxfCode.BlockName, BlockRecord.Name), 0)
Dim acSelFtr As SelectionFilter = New SelectionFilter(acTypValAr)
Dim acSSPrompt As PromptSelectionResult = acEditor.SelectAll(acSelFtr)
Dim acSSet As SelectionSet = acSSPrompt.Value
'……
Else
acEditor.WriteMessage(vbLf & "请选择图框参照块。")
Exit Sub
End If
acTrans.Commit()
End Using
If Err.Number <> 0 Then MsgBox(Err.Description)
End Sub
Public Sub SelectBlockRef()
On Error Resume Next
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Dim acEditor As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
Dim prEnt As PromptEntityOptions = New PromptEntityOptions("选择一个对象:")
Dim prEntRes As PromptEntityResult = acEditor.GetEntity(prEnt)
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
Dim Obj As Object = acTrans.GetObject(prEntRes.ObjectId, OpenMode.ForRead)
MsgBox(Obj.GetType.ToString) '返回对象类型
Dim ObjFullName As String = Obj.GetType.FullName
Dim ObjName As String = ObjFullName.Substring(InStrRev(ObjFullName, "."))
If ObjName = "BlockReference" Then
Dim BlockRef As BlockReference = Obj
Dim BlockRecord As BlockTableRecord
BlockRecord = acTrans.GetObject(BlockRef.BlockTableRecord, _
OpenMode.ForRead)
'这才得到参照块的名称
'MsgBox(BlockRecord.Name)
'过滤条件
Dim acTypValAr(0) As TypedValue
acTypValAr.SetValue(New TypedValue(DxfCode.BlockName, BlockRecord.Name), 0)
Dim acSelFtr As SelectionFilter = New SelectionFilter(acTypValAr)
Dim acSSPrompt As PromptSelectionResult = acEditor.SelectAll(acSelFtr)
Dim acSSet As SelectionSet = acSSPrompt.Value
'……
Else
acEditor.WriteMessage(vbLf & "请选择图框参照块。")
Exit Sub
End If
acTrans.Commit()
End Using
If Err.Number <> 0 Then MsgBox(Err.Description)
End Sub
|
暂时没有评论
发表评论 - 不要忘了输入验证码哦! |