社区 › VB › 将块插入到图形中

Jeff_M 发表于 2007-6-18 18:49:27

将块插入到图形中

好的，我&#039；很明显，我的大脑在放屁，但我可以#039；我想不出这是为了救我的命
I&#039；我从一张图上取一块，放在另一张图中
我不&#039；t有一个文件I&#039；m插入，I&#039；我并不是在动态中创建块
类似ThisDrawing.Blocks的内容。添加（MyBlockObject）
有什么想法吗&nbsp；这有意义吗？

Jeff_M 发表于 2007-6-18 19:02:42

CopyObjects？其中，要复制的对象是1个图形中的块定义，目标是第二个图形的块集合？

Jeff_M 发表于 2007-6-18 19:23:08

Can&#039；我不能让它工作
我尝试了以下方法    Dim BlockCollection(0) As Object
    Dim NewDrawing As Variant
   
    NewDrawing = ThisDrawing.ModelSpace
    Set BlockCollection(0) = BlockObject
   
    ThisDrawing.CopyObjects BlockCollection, NewDrawing

没有成功&nbsp；我得到一个；对象不在数据库中“；错误
你&#039；我认为这会更容易。英雄联盟

Jeff_M 发表于 2007-6-18 19:44:53

没有经过测试，但我认为它应该可以工作
Function CopyBlock2ThisDrawing(OtherDrawing As AcadDocument, strBname As String) As Boolean
   
    Dim oBlock As AcadBlock
    On Error Resume Next
    Set oBlock = OtherDrawing.Blocks(strBname)
    If Err Then
      CopyBlock2ThisDrawing = False
      Exit Function
    End If
    Dim oCopyMe(0) As AcadObject
    Set oCopyMe(0) = oBlock
    OtherDrawing.CopyObjects oCopyMe, ThisDrawing.Blocks
    CopyBlock2ThisDrawing = True
End Function

Jeff_M 发表于 2007-6-18 20:04:34

呸……没关系&nbsp；本人&#039；我是个白痴&nbsp；我在copyobjects语句中使用了我的源图形作为我的新图形。谢谢。这很有魅力
给我一点时间收拾东西，我&#039；我会发布完整的程序
这是一个方便的小工具，或者至少是。

Jeff_M 发表于 2007-6-18 20:16:47

好的。给你&#039；这是我正在做的部分；谢谢你，杰夫&nbsp；这将从外部文件中获取块定义，而无需使用AutoCAD打开它，并将其添加到当前图形中
I&#039；我将把要引入哪个块的计算和实际插入例程留给您个人的喜好。请确保添加对AutoCAD/ObjectDBX Common（ver#）类型库的引用Option Explicit
Function OpenSourceFile(FileName As String) As AXDBLib.AxDbDocument
   
    If Dir(FileName)"" 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为我指明了这个方向。

Jeff_M 发表于 2007-6-18 20:22:21

我想你可能在尝试这种方法，&#039；这就是为什么我选择只显示两个开放的图纸之间…我知道你&#039；d找出剩下的。

查看完整版本: 将块插入到图形中