用VBA重定义块。。

Keith · 发表于 2008-3-19 12:04:49

您好，
有一个程序，可以创建一个块，添加一个属性表，然后插入它，现在一切都可以正常工作了（感谢所有以前帮助过我的人）…
但是如果图形中已经有一个相同类型的块引用，我想用用户输入的新信息重新定义它，而不是添加到它，这似乎是在程序中做的…
，当用户表单加载时，它会检查块是否存在，并用其属性值填充用户表单，这很好，这允许用户编辑块中的信息，而不是每次都重新开始，但当用户完成程序并插入块时，它是现有和新信息的almagamma。有什么想法吗

Keith · 发表于 2008-3-19 14:15:05

如果图形中已经有块参照，您可以执行一些不同的操作…a）重命名旧块参照[b]，这是最理想的

Keith · 发表于 2008-3-19 14:18:07

唐#039；我现在没有时间测试它，但请为该DWG中的每个blkref尝试一个。mspace；如果blkref。名称=“”；x“；然后&nbsp；blkref。更新；如果下一个blkref，则结束

Keith · 发表于 2008-3-19 15:28:31

用户只是在更改属性信息，还是图形本身在更改
为什么要重新定义块定义？

Bryco · 发表于 2008-3-19 16:17:40

在将数据添加到块之前，请尝试此功能

copy

Function CleanoutBlock(currentBlock As AcadBlock)
    Dim blkItem As AcadEntity
    For Each blkItem In currentBlock
        blkItem.Delete
    Next blkItem
End Function

Keith · 发表于 2008-3-20 05:58:32

您好，
到目前为止，我已经在我的程序中尝试过这一点……（SSetX是它在用户表单加载时创建的一个选择集，用于检查现有块……

copy

'Redefine current block info if chart exists..
Dim BlK As AcadBlockReference
Dim EntX As AcadEntity
If SSetX.Count > 0 Then
    For Each BlK In SSetX
        If BlK.Name = "Fixings_Chart" Then
            For Each EntX In BlK
                EntX.Delete
            Next EntX
        End If
    Next BlK
End If

它标记一个错误，表示对象不&#039；我不支持这种方法，这显然是指BlockRef，如果我想访问其中的实体，它应该是一个块而不是一个块引用……那么我该从这里走到哪里
我也喜欢基思&#039；s函数：

copy

Function CleanoutBlock(currentBlock As AcadBlock)
    Dim blkItem As AcadEntity
    For Each blkItem In currentBlock
        blkItem.Delete
    Next blkItem
End Function

但是在添加新数据之前，如何从代码中调用函数呢

Keith · 发表于 2008-3-20 08:31:12

我不知道&#039；我不知道你的具体情况，但你的代码有一些潜在的问题，也许我们可以解决
显然，使用您提供的代码，您正在选择图形中的所有块，然后遍历它们。如果要编辑块参照，必须编辑块定义。如果编辑块定义，它将自动反映在所有块参照中，因此无需迭代图形中的所有块参照。使用您提供的代码，如果有效，它将为图形中插入的每个块实例反复重新定义同一块。这是不必要的，也不需要重复相同的程序
之前您说过，您有将项目放入块的代码，但您没有&#039；t没有代码从块中删除项。我提供的代码从作为参数传递给函数的块中删除了所有项。但必须传递AcadBlock，而不是AcadBlockReference
下载我在上一个线程中发布的模块并将其导入到您的项目中（在项目浏览器中右键单击并单击导入文件），然后将此代码添加到表单加载事件中

copy

Dim Blk As AcadBlock
If acBlock.BlockExists("Fixings_Chart").Exists = True Then
  Set Blk = ThisDrawing.Blocks.Item("Fixings_Chart")
  CleanoutBlock Blk '<-- call the CleanoutBlock function here
End If
'Add code here to put the new entities in the block 
'Blk.Addxxx functions to add the entities as needed

将此代码作为新函数添加到表单中[代码您可以提供更多的代码，我们可以为您指出错误所在。