GstarCAD Api ： WblockCloneObjects
您好，我对这段代码有问题：
Public Sub teste()
Dim ofd As New OpenFileDialog
If Not ofd.ShowDialog Then Exit Sub
Dim layoutTemplate As String = "MODELO_A4"
Dim layoutName As String = "NOVO_LAYOUT"
Dim handleBlocoCarimbo As String = "D66"
Dim handleMainViewPort As String = "C0E"
Dim handleLayoutViewPort As String = "C13"
Dim doc = ApplicationServices.Application.DocumentManager.MdiActiveDocument
Using tr = doc.TransactionManager.StartTransaction
Using dbOrig As New Database(False, True)
dbOrig.ReadDwgFile(ofd.FileName, FileShare.Read, True, "")
'Make the original database the working database
HostApplicationServices.WorkingDatabase = dbOrig
Using trOrig As Transaction = dbOrig.TransactionManager.StartTransaction()
' Get the dictionary of the original database
Dim lytDict As DBDictionary = trOrig.GetObject(dbOrig.LayoutDictionaryId, ForRead)
'Get the layout in the original database
Dim lytMgr As LayoutManager = LayoutManager.Current()
Dim layoutId As ObjectId = lytMgr.GetLayoutId(layoutTemplate)
Dim layout As Layout = trOrig.GetObject(layoutId, ForRead)
'Get the block table record of the existing layout
Dim blkTableRec As BlockTableRecord = trOrig.GetObject(layout.BlockTableRecordId, ForRead)
'Get the object ids of the objects in the existing block table record
Dim objIdCol As New ObjectIdCollection()
For Each objId As ObjectId In blkTableRec
objIdCol.Add(objId)
Next
'return to original WorkingDatabase
HostApplicationServices.WorkingDatabase = doc.Database
' Clone the objects to the new layout
Dim newLytMgr As LayoutManager = LayoutManager.Current()
If newLytMgr.GetLayoutId(layoutName).IsValid Then
newLytMgr.DeleteLayout(layoutName)
End If
Dim newLayoutId As ObjectId = newLytMgr.CreateLayout(layoutName)
Dim newLayout As Layout = newLayoutId.GetObject(OpenMode.ForWrite)
newLayout.CopyFrom(layout)
Dim idMap As New IdMapping()
doc.Database.WblockCloneObjects(objIdCol,
newLayout.BlockTableRecordId,
idMap,
DuplicateRecordCloning.Ignore,
False)
'define block attributes
Dim bid As ObjectId = HandleToObjectID(dbOrig, handleBlocoCarimbo)
Dim bref As BlockReference = idMap(bid).Value.GetObject(ForWrite)
If bref Is Nothing Then
MsgBox("error, bref is nothing")
Exit Sub
End If
For Each attid As ObjectId In bref.AttributeCollection
Dim attref As AttributeReference = attid.GetObject(ForWrite)
attref.TextString = "teste"
Next
'define viewport center
Dim vp As Viewport = idMap(HandleToObjectID(dbOrig, handleLayoutViewPort)).Value.GetObject(ForWrite)
vp.ViewCenter = New Point2d(0, 0)
vp.ViewTarget = Point3d.Origin 'para o viewcenter funcionar
'zoom extents no bloco do carimbo
vp = idMap(HandleToObjectID(dbOrig, handleMainViewPort)).Value.GetObject(ForWrite)
With bref.GeometricExtents
vp.ViewCenter = New Point2d((.MaxPoint.X + .MinPoint.X) / 2, (.MaxPoint.Y + .MinPoint.Y) / 2)
vp.ViewTarget = Point3d.Origin 'para o viewcenter funcionar
vp.ViewHeight = .MaxPoint.Y - .MinPoint.Y
End With
End Using 'trOrig
End Using 'dbOrig
If layoutName IsNot Nothing Then
LayoutManager.Current.CurrentLayout = layoutName
LayoutManager.Current.CurrentLayout = "Model"
End If
End Using
End Sub
Public Function HandleToObjectID(db As Database, ByVal h As String) As ObjectId
Try
Dim num As Long = Long.Parse(h, Globalization.NumberStyles.HexNumber)
Dim id As ObjectId = db.GetObjectId(False, New Handle(num), 0)
If id.IsErased Then Return ObjectId.Null
Return id
Catch
Return ObjectId.Null
End Try
End Function
运行它，选择附加DWT
它应该在当前图形中创建一个新布局，并将其插入设计“MODELOS.dwt”中现有布局的副本
中，但它不识别到原始布局中的块的映射
缺少什么？
**** Hidden Message ***** 不确定您是否先将模板块添加到块中，然后再将其添加到图纸空间中(这对我来说很有效)。
对于新图纸，我归档。副本(sTemplate，sPath)；将模板复制到具有新名称的新文件夹中 工作流程如下：
1）在模型空间中有一个细分的批次
2）在每个布局中将是每个批次的叶子
3）调用一个命令，要求选择一个包含布局模型的DWT
4）然后该命令使用布局模型创建各种布局。这个模型必须包含一个带有属性的块和一个视口。
5）命令将视口集中在批次的形心中，并填充块的属性
这个流程在AutoCAD中运行良好，显示的代码。
问题出在GstarCAD中，做“Wblock CloneObject”显然不是克隆一切，包括给出致命错误并关闭GstarCAD
如果它在AutoCAD中正常工作，我的建议是联系support@gstarcad.net 我已经这样做了
页:
[1]