用VBA重定义块。。

Keith · 发表于 2008-3-20 10:28:51

属性don#039；t更新
It&#039；更容易找到每个blockref并将其替换为；一个新的，首先匹配属性

Keith · 发表于 2008-3-20 11:30:00

但是可以肯定的是，使用Keith提供的删除块中所有实体的函数，不会出现&#039；不会是任何赢得#039；t更新，那么只有新属性才会出现和显示？

Keith · 发表于 2008-3-20 11:44:50

啊..现在我更全面地理解了您请求的性质…
据我所知，如果更改属性的数量，则更新属性的唯一方法是同步块引用。也可以使用VBA插入块，然后获取属性并修改它们
在VBA中，只能将属性附加到块、模型空间或图纸空间，没有addattributereference方法来添加对块中属性的引用
假设您正在使用AddAttribute将属性添加回块，那么您必须通过使用AddAttribute时，必须遍历每个AcadBlockReference，获取要保持不变的原点、比例、旋转、层等，然后插入具有相同信息的新块，然后根据需要更新属性

Bryco · 发表于 2008-3-20 12:15:39

哦，对了，甚至加上：

copy

' Checks if table exists and redefines (clearsout) the block of all data..
Function CleanoutBlock(currentBlock As AcadBlock)
    Dim blkItem As AcadEntity
    [color=red]Dim blkAtt As AcadAttribute[/color]
    For Each blkItem In currentBlock
        blkItem.Delete
    Next blkItem
[color=red]    For Each blkAtt In currentBlock
        blkAtt.Delete
    Next blkAtt[/color]
End Function

..你的功劳赢了#039；t工作
我试过了，但还是一无所获。我要做的就是从块中删除属性（和所有块实体），使其为空，然后将程序在块中执行的所有操作放回原处，因此如果用户在任何地方插入了任何块，这些块将反映用户在程序中选择的内容；这是该程序的简要说明：它从用户定义的数据创建一个固定图表/表（用户还可以从图形中插入的块中选择一个固定点，并在所选固定点的文本框中输入块名。可以创建10行，每行由复选框选择/取消选择。运行时，它为表/图表的每行添加两种类型的属性，一种是项目的参考号（常数）（即：FX1、FX2等），第二个是描述（普通），用户可以在userform的文本框中编辑。加载（userform_Initialise）时，程序搜索表的任何现有插入，并用该数据填充userform，以便用户可以编辑/添加到/删除等。完成后，它插入块（如果找到新的/没有现有表）或只是更新现有的。现在，使用我的代码（和Keith的添加），它可以工作99%，但刚刚赢了；t删除现有的正常属性（但它确实删除了常量属性（参考属性）…我认为，由于它删除了这些常量属性（顺便说一句，这个程序中的所有属性都是由Block.AddAttribute创建的），它也会删除正常属性，但它不会&#039；t、这是因为&#039；常数#039；属性的属性

Keith · 发表于 2008-3-20 13:51:43

您不理解…..VBA编辑块时，仅编辑块表中的属性。它不影响块引用b）如果在使用命令后使用attsync，则所有不&#039；t存在于块中，但附加到块引用的属性将从块引用中删除，并且块中但不在块引用中的所有属性将添加到块引用中
VBA没有处理代码的机制，因此，您必须创建自己的
我之前发布的代码实际上删除了块中的属性，但没有删除块引用。在VBA中没有这样做的方法，您可以执行以下操作之一：
1）运行程序后在命令行执行attsync<2）删除图形中所有出现的Fixings\u图表，并将其替换为新的块引用

copy

    Dim OldBlkRef As AcadBlockReference
    Dim NewBlkRef As AcadBlockReference
    
    For Each OldBlkRef In ThisDrawing.ModelSpace
        With OldBlkRef
            If UCase(.Name) = "FIXINGS_CHART" Then
                Set NewBlkRef = ThisDrawing.ModelSpace.InsertBlock(.InsertionPoint, .Name, .XScaleFactor, .YScaleFactor, .ZScaleFactor, .Rotation)
                NewBlkRef.layer = .layer
                NewBlkRef.Color = .Color
                NewBlkRef.Linetype = .Linetype
                NewBlkRef.LinetypeScale = .LinetypeScale
                NewBlkRef.Lineweight = .Lineweight
                NewBlkRef.Normal = .Normal
                NewBlkRef.Visible = .Visible
                ' transfer all of the attribute tag values over in this area
                ' if you want to keep the existing values in the attributes
                .Delete
            End If
        End With
    Next OldBlkRef

现在需要记住的重要一点是，如果使用代码替换现有块引用，则需要手动填充所有属性，除非在块中使用默认值设置属性值。

用VBA重定义块。。

发表回复

精选推荐