[推荐]深入研究《锁定标注文字不随对象缩放而动态变化》示例

兰州人

原文及程序详见AutoCAD VBA二次开发教程
  第127页-132页。

以下程序与原程序区别是用debug.print，测试关键点返回数据。

Function FixDimText(Dimension As AcadDimension) As String

    '在复制标注对象前先保存当前图形中的块数量

    Dim BlockCount As Long

    Debug.Print Dimension.ObjectName, Dimension.OwnerID, Dimension.TextOverride

    BlockCount = ThisDrawing.Blocks.Count

    Debug.Print BlockCount

    '复制需要锁定文字内容的标注对象

    Dim CopyDimension As AcadDimension

    Set CopyDimension = Dimension.Copy

    '检查块数量是否增加，而且新增加的块名前缀是否为"*D"

    Dim NewBlockCount As Long

    NewBlockCount = ThisDrawing.Blocks.Count

    Debug.Print NewBlockCount

    If NewBlockCount = BlockCount + 1 And Left(ThisDrawing.Blocks(BlockCount).Name, 2) = "*D" Then   

        '遍历块中的对象，取得文字内容

        Dim EntityInBlock As AcadEntity

        For Each EntityInBlock In ThisDrawing.Blocks(BlockCount)

            Debug.Print EntityInBlock.ObjectName, EntityInBlock.OwnerID

            If EntityInBlock.ObjectName = "AcDbMText" Then

                '将文字内容替换掉标注对象的文字内容

                Dimension.TextOverride = EntityInBlock.TextString

                Exit For

            End If

        Next

    End If

    '删除复制的标注对象

    CopyDimension.Delete

    FixDimText = Dimension.TextOverride

End Function

 

 

通过测试不同的施工图（不同的单位、不同的个人的dwg文件）后，发现

NewBlockCount = BlockCount + 1 And Left(ThisDrawing.Blocks(BlockCount).Name, 2) = "*D"

的运行结果为False，导致整个程序无法运行。

 

 

正确运行这个程序的结果

AcDbRotatedDimension         2130001144   200{}{}

 10

 11

能找到*D的OwnerID

AcDbLine       2123471264

AcDbLine       2123471264

AcDbLine       2123471264

AcDbSolid      2123471264

AcDbSolid      2123471264

AcDbMText      2123471264

不正确运行这个程序的结果为

AcDbRotatedDimension         2130001144   120{}{}

找不到*D的OwnerID

讨论的问题是

*D与dimension的父子关系

*D的OwnerID与dimension的OwnerID的关系。

mccad

自从AutoCAD有了关联标注后，使用这种方法来取得标注对应的图块就不灵验了。

从目前看只能使用你上次外国佬写的那个标注对象所对应图块的程序来解决。