求助 vb.net 无法插入块

hrbustmqc · 发表于 2014-6-10 16:41

本帖最后由 hrbustmqc 于 2014-6-10 16:47 编辑

做个简单的程序，在cad中插入直线，在直线的端点插入一个块（“断路器”），运行后只能生成直线，却不能插入块

Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.EditorInput
Public Class Class1
<CommandMethod("AddLine")> _
Public Sub AddLine()
'' 获取当前文档和数据库
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Dim acEditor As Editor = acDoc.Editor
Using (acDoc.LockDocument)
'' 启动事务
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
'' 以读模式打开块表
Dim acBlkTbl As BlockTable
acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead)
'' 以写模式打开块表记录模型空间
Dim acBlkTblRec As BlockTableRecord
acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), _
OpenMode.ForWrite)
'' 拾取点
Dim pPtRes As PromptPointResult
Dim pPtOpts As PromptPointOptions = New PromptPointOptions("")
pPtOpts.Message = vbLf & "Insert Point of Block:"
pPtRes = acEditor.GetPoint(pPtOpts)
Dim InsertPt As Point3d = pPtRes.Value
'' 创建直线
Dim acLine As Line = New Line(New Point3d(InsertPt.X, InsertPt.Y, 0), _
New Point3d(InsertPt.X + 1000, InsertPt.Y, 0))
Dim FilePath As String = "G:\断路器.dwg"
Dim FileName As String = "断路器.dwg"
Dim BlockName As String = "断路器"
Dim Block As BlockReference = New BlockReference(New Point3d(InsertPt.X + 1000, InsertPt.Y, 0), acBlkTbl(BlockName))
Block.ScaleFactors = New Scale3d(1, 1, 1)
Block.Rotation = 0
'' 将新对象添加到块表记录和事务
acBlkTblRec.AppendEntity(Block)
acTrans.AddNewlyCreatedDBObject(Block, True)
acBlkTblRec.AppendEntity(acLine)
acTrans.AddNewlyCreatedDBObject(acLine, True)
'' 将新对象保存到数据库
acTrans.Commit()
End Using
End Using
End Sub
End Class

Imports Autodesk.<a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a>.Runtime 
Imports Autodesk.AutoCAD.ApplicationServices 
Imports Autodesk.AutoCAD.DatabaseServices 
Imports Autodesk.AutoCAD.Geometry 
Imports Autodesk.AutoCAD.EditorInput 
Public Class Class1 
 
    <CommandMethod("AddLine")> _ 
    Public Sub AddLine() 
        '' 获取当前文档和数据库 
        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument 
        Dim acCurDb As Database = acDoc.Database 
        Dim acEditor As Editor = acDoc.Editor 
        Using (acDoc.LockDocument) 
            '' 启动事务 
            Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction() 
                '' 以读模式打开 块表 
                Dim acBlkTbl As BlockTable 
                acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead) 
                '' 以写模式打开 块表记录模型空间 
                Dim acBlkTblRec As BlockTableRecord 
                acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), _ 
                OpenMode.ForWrite) 
 
                '' 拾取点 
                Dim pPtRes As PromptPointResult 
                Dim pPtOpts As PromptPointOptions = New PromptPointOptions("") 
                pPtOpts.Message = vbLf & "Insert Point of Block:" 
                pPtRes = acEditor.GetPoint(pPtOpts) 
                Dim InsertPt As Point3d = pPtRes.Value 
                '' 创建直线 
                Dim acLine As Line = New Line(New Point3d(InsertPt.X, InsertPt.Y, 0), _ 
                New Point3d(InsertPt.X + 1000, InsertPt.Y, 0)) 
 
                Dim FilePath As String = "G:\断路器.dwg" 
                Dim FileName As String = "断路器.dwg" 
                Dim BlockName As String = "断路器" 
 
                Dim Block As BlockReference = New BlockReference(New Point3d(InsertPt.X + 1000, InsertPt.Y, 0), acBlkTbl(BlockName)) 
                Block.ScaleFactors = New Scale3d(1, 1, 1) 
                Block.Rotation = 0 
 
                '' 将新对象添加到块表记录和事务 
                acBlkTblRec.AppendEntity(Block) 
                acTrans.AddNewlyCreatedDBObject(Block, True) 
                acBlkTblRec.AppendEntity(acLine) 
                acTrans.AddNewlyCreatedDBObject(acLine, True) 
                '' 将新对象保存到数据库 
                acTrans.Commit() 
            End Using 
        End Using 
    End Sub 
End Class

raohuan · 发表于 2014-6-10 21:30

如果你当前图面中没有定义"断路器"这个图块，就不可能将"断路器"图块插入到模型空间！

我猜你是想将外部保持的图块插入到当前图面中吧，这个方法可不行啊！

hrbustmqc · 发表于 2014-6-10 21:53

Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.EditorInput
Public Class Class1
<CommandMethod("InserBlock")> _
Public Sub InserBlock()
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acDatabase As Database = acDoc.Database
Dim acEditor As Editor = acDoc.Editor
Dim pPtRes As PromptPointResult
Dim pPtOpts As PromptPointOptions = New PromptPointOptions("")
pPtOpts.Message = vbLf & "Insert Point of Block:"
pPtRes = acEditor.GetPoint(pPtOpts)
Dim InsertPt As Point3d = pPtRes.Value
If pPtRes.Status = PromptStatus.Cancel Then
Exit Sub
End If
Using (acDoc.LockDocument)
Using trans As Transaction = acDatabase.TransactionManager.StartTransaction
Dim acBlockTable As BlockTable = trans.GetObject(acDatabase.BlockTableId, OpenMode.ForWrite)
Dim FilePath As String = "G:\断路器.dwg"
Dim FileName As String = "断路器.dwg"
Dim BlockName As String = "断路器"
If acBlockTable.Has(BlockName) = True Then
Dim Block As BlockReference = New BlockReference(InsertPt, acBlockTable(BlockName))
Block.ScaleFactors = New Scale3d(1, 1, 1)
Block.Rotation = 0
Dim ModelSpace As BlockTableRecord = trans.GetObject(acDatabase.CurrentSpaceId, OpenMode.ForWrite)
ModelSpace.AppendEntity(Block)
trans.AddNewlyCreatedDBObject(Block, True)
trans.Commit()
Else
Dim db As New Database(False, False)
'sourceDb.ReadDwgFile("c:\\xxx.dwg", System.IO.FileShare.Read, true, "");
db.ReadDwgFile(FilePath, System.IO.FileShare.Read, False, "")
Dim id As ObjectId = acDatabase.Insert(FileName, db, False)
If id.IsValid = False Then
Exit Sub
End If
Dim Block As BlockReference = New BlockReference(InsertPt, acBlockTable(BlockName))
Block.ScaleFactors = New Scale3d(1, 1, 1)
Block.Rotation = 0
Dim ModelSpace As BlockTableRecord = trans.GetObject(acDatabase.CurrentSpaceId, OpenMode.ForWrite)
ModelSpace.AppendEntity(Block)
trans.AddNewlyCreatedDBObject(Block, True)
trans.Commit()
End If
End Using
End Using
End Sub
End Class

Imports Autodesk.AutoCAD.Runtime 
Imports Autodesk.AutoCAD.ApplicationServices 
Imports Autodesk.AutoCAD.DatabaseServices 
Imports Autodesk.AutoCAD.Geometry 
Imports Autodesk.AutoCAD.EditorInput 
Public Class Class1 
   
    <CommandMethod("InserBlock")> _ 
    Public Sub InserBlock() 
        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument 
        Dim acDatabase As Database = acDoc.Database 
        Dim acEditor As Editor = acDoc.Editor 
        Dim pPtRes As PromptPointResult 
        Dim pPtOpts As PromptPointOptions = New PromptPointOptions("") 
 
        pPtOpts.Message = vbLf & "Insert Point of Block:" 
        pPtRes = acEditor.GetPoint(pPtOpts) 
        Dim InsertPt As Point3d = pPtRes.Value 
 
        If pPtRes.Status = PromptStatus.Cancel Then 
            Exit Sub 
        End If 
 
        Using (acDoc.LockDocument) 
            Using trans As Transaction = acDatabase.TransactionManager.StartTransaction 
                Dim acBlockTable As BlockTable = trans.GetObject(acDatabase.BlockTableId, OpenMode.ForWrite) 
                Dim FilePath As String = "G:\断路器.dwg" 
                Dim FileName As String = "断路器.dwg" 
                Dim BlockName As String = "断路器" 
 
                If acBlockTable.Has(BlockName) = True Then 
                    Dim Block As BlockReference = New BlockReference(InsertPt, acBlockTable(BlockName)) 
                    Block.ScaleFactors = New Scale3d(1, 1, 1) 
                    Block.Rotation = 0 
 
                    Dim ModelSpace As BlockTableRecord = trans.GetObject(acDatabase.CurrentSpaceId, OpenMode.ForWrite) 
                    ModelSpace.AppendEntity(Block) 
 
                    trans.AddNewlyCreatedDBObject(Block, True) 
                    trans.Commit() 
                Else 
                    Dim db As New Database(False, False) 
                    'sourceDb.ReadDwgFile("c:\\xxx.dwg", System.IO.FileShare.Read, true, ""); 
                    db.ReadDwgFile(FilePath, System.IO.FileShare.Read, False, "") 
                    Dim id As ObjectId = acDatabase.Insert(FileName, db, False) 
 
                    If id.IsValid = False Then 
                        Exit Sub 
                    End If 
 
                    Dim Block As BlockReference = New BlockReference(InsertPt, acBlockTable(BlockName)) 
                    Block.ScaleFactors = New Scale3d(1, 1, 1) 
                    Block.Rotation = 0 
 
                    Dim ModelSpace As BlockTableRecord = trans.GetObject(acDatabase.CurrentSpaceId, OpenMode.ForWrite) 
                    ModelSpace.AppendEntity(Block) 
 
                    trans.AddNewlyCreatedDBObject(Block, True) 
                    trans.Commit() 
 
                End If 
            End Using 
        End Using 
    End Sub 
 
End Class

断路器图块是个单独的文件。这个代码可以执行。跟第一个例子结合后就不能插入了，不知道为什么，请大家帮忙看看

sieben · 发表于 2014-6-10 22:49

自己仔细看看上下代码有没有什么不同?

hrbustmqc · 发表于 2014-6-10 22:51

我就看出来几个定义的名字不一样，我都统一了，其他的没看出来，还望明鉴

sieben · 发表于 2014-6-11 08:46

            Dim db As New Database(False, False)
43.                   'sourceDb.ReadDwgFile("c:\\xxx.dwg", System.IO.FileShare.Read, true, "");
44.                   db.ReadDwgFile(FilePath, System.IO.FileShare.Read, False, "")
------------------------------------
一楼代码里面有没有这些?

hrbustmqc · 发表于 2014-6-11 10:55

唉！刚开始学二次开发差的太多了，大概明白这段代码的意思了，如若当前文件包含“断路器块”，就直接插入，如果当前文件不包含块，按照路径打开“断路器块”。显然我的“断路器块”是外部文件，所以我之前的代码不可能成功，晚上我试着改一改。谢谢sieben，热心网友。

flyhorse · 发表于 2015-2-18 00:09

hrbustmqc 发表于 2014-6-10 21:53
断路器图块是个单独的文件。这个代码可以执行。跟第一个例子结合后就不能插入了，不知道为什么，请大家帮忙 ...

已经试了，这个办法没问题。谢谢！

ZKSJLL · 发表于 2018-11-29 13:15

自己仔细看看上下代码有没有什么不同?

问号兄233 · 发表于 2018-12-10 16:03

初次二开这个问题必然接触啊，我刚开始也琢磨了好几天

账号		自动登录	找回密码
密码			注册

[基础] 求助 vb.net 无法插入块