明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 834|回复: 2

[基础] 求助!vb.net wblcok图形到指定CAD文档后,原CAD文档无法保存或另存

[复制链接]
发表于 2016-6-28 19:27 | 显示全部楼层 |阅读模式
    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文档无法保存、另存
 楼主| 发表于 2016-6-28 19:30 | 显示全部楼层
保存或另存时提示。dwg有命令正在执行!
 楼主| 发表于 2016-6-29 23:08 | 显示全部楼层
问题解决了,不能直接用doc.LockDocument()   然后doc.LockDocument().Dispose()
必须
Using doc As DocumentLock = Application.DocumentManager.MdiActiveDocument.LockDocument
       ‘代码
end using
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-4-23 17:02 , Processed in 0.245460 second(s), 23 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表