求助！vb.net wblcok图形到指定CAD文档后，原CAD文档无法保存或另存
Public Shared Sub 输出DWG(TextInPaperSpace() As MText)Dim dm As DocumentCollection = Application.DocumentManager
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = dm.MdiActiveDocument.Editor
'获取当前数据库作为目标数据库
Dim Db As Database = dm.MdiActiveDocument.Database
doc.LockDocument()
Dim optPoint As PromptPointOptions = New PromptPointOptions("\n请指定矩形一个角点")
Dim resPoint As PromptPointResult = ed.GetPoint(optPoint)
If (resPoint.Status <> PromptStatus.OK) Then Return
'得到第一个角点的UCS坐标.
Dim pt1 As Point3d = resPoint.Value
'初始化矩形
Dim polyLine As Polyline = New Polyline
For i As Integer = 0 To 3
polyLine.AddVertexAt(i, New Point2d(0, 0), 0, 0, 0)
Next
polyLine.Closed = True
Dim RecJig As CsharpClass.RecJig = New CsharpClass.RecJig(pt1, polyLine)
Dim resJig As PromptResult = ed.Drag(RecJig)
If (resJig.Status = PromptStatus.OK) Then
'窗选需要输出图形
Dim resSel As PromptSelectionResult = ed.SelectCrossingWindow(polyLine.GetPoint3dAt(0), polyLine.GetPoint3dAt(2))
Dim sSet As SelectionSet = resSel.Value
If sSet Is Nothing Then Return
Dim ids As ObjectIdCollection = New ObjectIdCollection(sSet.GetObjectIds())
Dim ViewCenter As Point2d = New Point2d(polyLine.GetPoint3dAt(0).X + (polyLine.GetPoint3dAt(2).X - polyLine.GetPoint3dAt(0).X) / 2, _
polyLine.GetPoint3dAt(0).Y + (polyLine.GetPoint3dAt(2).Y - polyLine.GetPoint3dAt(0).Y) / 2)
Dim 比例值 As Double = 1
比例值 = 函数库.优化比例(RecJig.Width, RecJig.Height, 40, 250, 30, 150)
Dim 比例 As New 绘图比例(比例值)
Using trans As Transaction = Db.TransactionManager.StartTransaction()
For Each id As ObjectId In ids
Dim ENT As Entity = trans.GetObject(id, OpenMode.ForWrite)
If TypeOf ENT Is Dimension Then
Dim dims As Dimension = CType(ENT, Dimension)
Dim dt As DimStyleTable = trans.GetObject(Db.DimStyleTableId, OpenMode.ForWrite)
Dim dtid As ObjectId = dt.Item(比例.比例字符)
dims.DimensionStyle = dtid
Db.Dimstyle = dtid
Dim dsr As DimStyleTableRecord = trans.GetObject(Db.Dimstyle, OpenMode.ForRead)
Db.SetDimstyleData(dsr)
End If
Next
trans.Commit()
End Using
doc.LockDocument().Dispose()
Dim filename As String = "D:\试用版\绘图模板\模板.dwg" '小图模板
Dim tagdoc As Document = dm.Open(filename, False)
dm.MdiActiveDocument = tagdoc
tagdoc.LockDocument()
Dim tagdb As Database = tagdoc.Database
Using trans As Transaction = tagdoc.TransactionManager.StartTransaction()
Db.Wblock(tagdb, ids, tagdb.Ucsorg, DuplicateRecordCloning.Ignore)
Dim lm As LayoutManager = LayoutManager.Current
Dim layName As String = "布局1"
'设置为当前布局
lm.CurrentLayout = layName
Dim vport As New Viewport
vport.CenterPoint = New Point3d(148.5, 105, 0)
vport.Width = 287
vport.Height = 200
tagdb.AddToPaperSpace(vport)
vport.ViewDirection = New Vector3d(0, 0, 1)
vport.CustomScale = 比例值
trans.Commit()
End Using
For G As Integer = 0 To TextInPaperSpace.Length - 1
函数库.AppendEntityToPaperSpace(TextInPaperSpace(G))
Next
Dim 文件夹名 As String = Path.GetDirectoryName(doc.Name) & "\零件图\"
Dim 保存文件名 As String = "零件图"
If Trim(TextInPaperSpace(2).Text) <> "" Then
保存文件名 = TextInPaperSpace(2).Text
Else
保存文件名 = "零件图"
End If
Directory.CreateDirectory(文件夹名)
Dim 另存文件名 As String = 文件夹名 & 保存文件名
tagdoc.LockDocument.Dispose()
tagdb.SaveAs(另存文件名 & ".dwg", DwgVersion.AC1015) '
dm.MdiActiveDocument = tagdoc
tagdoc.CloseAndDiscard()
End If
End Sub
以上代码运行完之后 ，原cad文档无法保存、另存
保存或另存时提示。dwg有命令正在执行！ 问题解决了，不能直接用doc.LockDocument() 然后doc.LockDocument().Dispose()
必须
Using doc As DocumentLock = Application.DocumentManager.MdiActiveDocument.LockDocument
‘代码
end using
页:
[1]