田草博客

互联网田草博客


网友交流QQ群:11740834 需注明申请加入原因

微信 公众号:ByCAD

邮箱:tiancao1001x126.com
ByCAD,微信公众号
首页 | 普通 | 电脑 | AutoCAD | VB/VB.NET | FLash | 结构 | 建筑 | 电影 | BIM | 规范 | 软件 | ID
-随机-|-分布-
-博客论坛-|-﨣﨤﨧﨨-
-网站导航-|-规范下载-
-BelovedFLash欣赏-

用户登陆
用户:
密码:
 

站点日历
73 2024 - 12 48
1234567
891011121314
15161718192021
22232425262728
293031


站点统计

最新评论



CAD二次开发判断点是否在一个区域内 AutoCAD的DWG文件格式版本代码列表
未知 Copy Objects Between Databases   [ 日期:2021-04-07 ]   [ 来自:本站原创 ]  HTML
http://help.autodesk.com/view/ACD/2015/ENU/?g ... 61FF-4C72-8960-0AEEBBEC2594


程序代码:

Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
 
<CommandMethod("CopyObjectsBetweenDatabases", CommandFlags.Session)> _
Public Sub CopyObjectsBetweenDatabases()
    Dim acObjIdColl As ObjectIdCollection = New ObjectIdCollection()

    '' Get the current document and database
    Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
    Dim acCurDb As Database = acDoc.Database

    '' Lock the current document
    Using acLckDocCur As DocumentLock = acDoc.LockDocument()

        '' Start a transaction
        Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()

            '' Open the Block table for read
            Dim acBlkTbl As BlockTable
            acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead)

            '' Open the Block table record Model space for write
            Dim acBlkTblRec As BlockTableRecord
            acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), _
                                            OpenMode.ForWrite)

            '' Create a circle that is at (0,0,0) with a radius of 5
            Using acCirc1 As Circle = New Circle()
                acCirc1.Center = New Point3d(0, 0, 0)
                acCirc1.Radius = 5

                '' Add the new object to the block table record and the transaction
                acBlkTblRec.AppendEntity(acCirc1)
                acTrans.AddNewlyCreatedDBObject(acCirc1, True)

                '' Create a circle that is at (0,0,0) with a radius of 7
                Using acCirc2 As Circle = New Circle()
                    acCirc2.Center = New Point3d(0, 0, 0)
                    acCirc2.Radius = 7

                    '' Add the new object to the block table record and the transaction
                    acBlkTblRec.AppendEntity(acCirc2)
                    acTrans.AddNewlyCreatedDBObject(acCirc2, True)

                    '' Add all the objects to copy to the new document
                    acObjIdColl = New ObjectIdCollection()
                    acObjIdColl.Add(acCirc1.ObjectId)
                    acObjIdColl.Add(acCirc2.ObjectId)
                End Using
            End Using

            '' Save the new objects to the database
            acTrans.Commit()
        End Using

        '' Unlock the document
    End Using

    '' Change the file and path to match a drawing template on your workstation
    Dim sLocalRoot As String = Application.GetSystemVariable("LOCALROOTPREFIX")
    Dim sTemplatePath As String = sLocalRoot + "Template\acad.dwt"

    '' Create a new drawing to copy the objects to
    Dim acDocMgr As DocumentCollection = Application.DocumentManager
    Dim acNewDoc As Document = DocumentCollectionExtension.Add(acDocMgr, sTemplatePath)
    Dim acDbNewDoc As Database = acNewDoc.Database

    '' Lock the new document
    Using acLckDoc As DocumentLock = acNewDoc.LockDocument()

        '' Start a transaction in the new database
        Using acTrans = acDbNewDoc.TransactionManager.StartTransaction()

            '' Open the Block table for read
            Dim acBlkTblNewDoc As BlockTable
            acBlkTblNewDoc = acTrans.GetObject(acDbNewDoc.BlockTableId, _
                                               OpenMode.ForRead)

            '' Open the Block table record Model space for read
            Dim acBlkTblRecNewDoc As BlockTableRecord
            acBlkTblRecNewDoc = acTrans.GetObject(acBlkTblNewDoc(BlockTableRecord.ModelSpace), _
                                                  OpenMode.ForRead)

            '' Clone the objects to the new database
            Dim acIdMap As IdMapping = New IdMapping()
            acCurDb.WblockCloneObjects(acObjIdColl, acBlkTblRecNewDoc.ObjectId, acIdMap, _
                                       DuplicateRecordCloning.Ignore, False)

            '' Save the copied objects to the database
            acTrans.Commit()
        End Using

        '' Unlock the document
    End Using

    '' Set the new document current
    acDocMgr.MdiActiveDocument = acNewDoc
End Sub




暂时没有评论
发表评论 - 不要忘了输入验证码哦!
作者: 用户:  密码:   注册? 验证:  防止恶意留言请输入问题答案:1*2=?  
评论:

禁止表情
禁止UBB
禁止图片
识别链接
识别关键字

字体样式 文字大小 文字颜色
插入粗体文本 插入斜体文本 插入下划线
左对齐 居中对齐 右对齐
插入超级链接 插入邮件地址 插入图像
插入 Flash 插入代码 插入引用
插入列表 插入音频文件 插入视频文件
插入缩进符合
点击下载按钮 下标 上标
水平线 简介分割标记
表  情
 
Tiancao Blog All Rights Reserved 田草博客 版权所有
Copyright ©