尺寸线复制给块，获得AcDbMtext

兰州人

对于尺寸图元 dim objDim as AcadDimension
debug.print  objDim.TextOverride 有两种可能数据内容tt 或Empty.
以下程序可以解决,Debug.print 每个尺寸的数据.
Sub ls()
  Dim Ent As AcadEntity, objDim As AcadDimension
  Dim tempBlock As AcadBlock
  With ThisDrawing
    'Debug.Print .Blocks.Count, "ModelSpace:  " & .ModelSpace.Count
    For Each Ent In .ModelSpace
     
     If Ent.ObjectName Like "AcDb*Dimension" Then
       Set objDim = Ent.Copy()
       blkCount = .Blocks.Count
       Set tempBlock = .Blocks.Item(blkCount - 1)
       For jj = 0 To tempBlock.Count - 1
         Select Case tempBlock.Item(jj).ObjectName
           Case "AcDbMText"
             Debug.Print tempBlock(jj).TextString
            
             'Ent.TextOverride = tempBlock(jj).TextString
           Case "AcDbPoint"
         End Select
       Next jj
       objDim.Delete
     End If
     'Debug.Print .Blocks.Count, "ModelSpace" & .ModelSpace.Count
    Next Ent
  End With
End Sub
''

2. [code]Sub ls()
3.   Dim Ent As AcadEntity, objDim As AcadDimension
4.   Dim tempBlock As AcadBlock
5.   With ThisDrawing
6.     'Debug.Print .Blocks.Count, "ModelSpace:  " & .ModelSpace.Count
7.    
8.     For Each Ent In .ModelSpace
9.      
10.      If Ent.ObjectName Like "AcDb*Dimension" Then
11.        Set objDim = Ent.Copy()
12.        blkCount = .Blocks.Count - 1
13.        Debug.Print "BLKCOUNT", blkCount
14. If blkCount + 1 And Left(.Blocks(blkCount).Name, 2) = "*D" Then
15.         Set tempBlock = .Blocks.Item(blkCount)
16.         Debug.Print objDim.Handle, tempBlock.Handle
17.        For jj = 0 To tempBlock.Count - 1
18.          Select Case tempBlock.Item(jj).ObjectName
19.            Case "AcDbMText"
20.              Debug.Print tempBlock(jj).TextString
21.             
22.              'Ent.TextOverride = tempBlock(jj).TextString
23.            Case "AcDbPoint"
24.          End Select
25.        Next jj
26.        objDim.Delete
27. End If
28.      End If
29.      
30.      'Debug.Print .Blocks.Count, "ModelSpace" & .ModelSpace.Count
31.     Next Ent
32.   End With
33. End Sub

[code]Sub ls()   Dim Ent As AcadEntity, objDim As AcadDimension   Dim tempBlock As AcadBlock   With ThisDrawing     'Debug.Print .Blocks.Count, "ModelSpace:  " & .ModelSpace.Count         For Each Ent In .ModelSpace            If Ent.ObjectName Like "AcDb*Dimension" Then        Set objDim = Ent.Copy()        blkCount = .Blocks.Count - 1        Debug.Print "BLKCOUNT", blkCount If blkCount + 1 And Left(.Blocks(blkCount).Name, 2) = "*D" Then         Set tempBlock = .Blocks.Item(blkCount)         Debug.Print objDim.Handle, tempBlock.Handle        For jj = 0 To tempBlock.Count - 1          Select Case tempBlock.Item(jj).ObjectName            Case "AcDbMText"              Debug.Print tempBlock(jj).TextString                           'Ent.TextOverride = tempBlock(jj).TextString            Case "AcDbPoint"          End Select        Next jj        objDim.Delete End If      End If            'Debug.Print .Blocks.Count, "ModelSpace" & .ModelSpace.Count     Next Ent   End With End Sub

[/code]