用VBA重新定义块..

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

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

本帖以下内容被隐藏保护；需要你回复后，才能看到！

游客，如果您要查看本帖隐藏内容请回复

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

如果图形中已经有一个块参照，则可以执行一些不同的操作...
a）重命名旧的块引用
b）以编程方式删除旧定义中的所有对象
c）删除现有引用并清除图形
3，
b
认为是最理想的

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

现在没有时间测试它，但是
如果 blkref.name = “x”，那么对于thisdwg.mspace中的每个blkref尝试一个
，如果

下一个blkref，则blkref.update结束

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

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

hardwired · 发表于 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 是在加载 UserForm 时创建的选择集，用于检查现有块。

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

......它标记了一个错误，说对象不支持此方法，这显然是引用BlockRef，如果我想访问其中的实体，应该是Block而不是BlockRef....那么我该何去何从？
我也喜欢基思的函数：

copy

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

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

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

我不知道你的确切情况，但你的代码有一些潜在的问题，也许我们可以解决。
使用您提供的代码，您显然是在选择图形中的所有块，然后遍历所有块。如果要编辑块引用，则必须编辑块定义。如果编辑块定义，它将自动反映在所有块参照中，从而消除了循环访问绘图中所有块参照的需要。使用您提供的代码，如果它有效，它将为该块插入到图形中的每个实例一遍又一遍地重新定义相同的块。这是没有必要的，也是对同一程序的不必要重复。
前面你说过你有将项目放入块中的代码，但你没有代码从块中删除项目。我提供的代码从您作为参数传递给函数的块中删除所有项目。但是你必须通过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

将此代码作为新函数添加到表单
中

copy

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

您可以提供更多的代码，我们可以为您提供有关您出错的地方的指示。