将块插入到图形中
**** Hidden Message ***** CopyObjects？其中，要复制的对象是1个图形中的块定义，目标是第二个图形的块集合。不能让它工作
我尝试了以下方法
Dim BlockCollection(0) As Object
Dim NewDrawing As Variant
NewDrawing = ThisDrawing.ModelSpace
Set BlockCollection(0) = BlockObject
ThisDrawing.CopyObjects BlockCollection, NewDrawing
没有成功。我得到一个“对象不在数据库中”错误 "" Then
Dim SourceDWG As New AXDBLib.AxDbDocument
SourceDWG.Open (FileName)
If Err.Number0 Then
If Err.Number-2147467259 Then 'File Moved
SourceDWG.Open (FileName)
End If
End If
Set OpenSourceFile = SourceDWG
End If
End Function
Function ImportBlock(SourceName As String, BlockName As String) As AcadBlock
Dim SourceDWG As New AXDBLib.AxDbDocument
Dim EvryBlock As AcadBlock
Set SourceDWG = OpenSourceFile(SourceName)
For Each EvryBlock In SourceDWG.Blocks
If UCase(BlockName) = UCase(EvryBlock.Name) Then
Set ImportBlock = EvryBlock
End If
Next
Dim BlockCollection(0) As AcadObject
Set BlockCollection(0) = ImportBlock
SourceDWG.CopyObjects BlockCollection, ThisDrawing.Blocks
Set SourceDWG = Nothing
End Function
Sub Palette_Helper_Blocks()
Dim SourceFile As String
Dim BlockName As String
SourceFile = "ContentMaster.dwg"
BlockName = ""
ImportBlock SourceFile, BlockName
End Sub
的引用
，也感谢 jbuzzbee 为我指出了这个方向。 我想你可能会尝试这种方法，这就是为什么我选择只显示两个开放的图纸...我知道你会想出其他办法的。
页:
[1]