[讨论]非常奇怪的现象，付源码

jsyang_ren

程序为把标注中的＜＞变为实际数值 但是我在一些图中测试成功，但在一些复杂的图形中的标注无法完全把 标注中的＜＞变为实际数值 望高手指点，在线等～～～～～～～～～～～ Public keyWord As String
Public m As Integer
Public n As Integer
Public Sub SelfOverRide(objDim As AcadSelectionSet)
Dim objBlk As AcadBlock
Dim objEnt As AcadEntity
Dim objEnt2 As AcadEntity
Dim varPos As Variant
Dim varInsPnt As Variant
Dim objDimText As AcadMText
Dim objBlocks As AcadBlocks
Dim blnDone As Boolean
'On Error Resume Next
Set objBlocks = ThisDrawing.Blocks
'varPos = objDim.TextPosition
'For Each objBlk In objBlocks
' If Not blnDone Then
m = 0
n = 0
For Each objEnt2 In objDim
If TypeOf objEnt2 Is AcadDimension Then
varPos = objEnt2.TextPosition
m = m + 1
For Each objBlk In objBlocks
If Left(objBlk.Name, 2) = "*D" Then
For Each objEnt In objBlk
If TypeOf objEnt Is AcadMText Then
Set objDimText = objEnt
varInsPnt = objDimText.InsertionPoint
If varInsPnt(0) = varPos(0) Then
If varInsPnt(1) = varPos(1) Then
If keyWord = "T" Then
objEnt2.TextOverride = objDimText.TextString
Else
objEnt2.TextOverride = "<>"
End If
n = n + 1
Exit For
End If
End If
End If
Next objEnt
End If
Next objBlk
End If
Next objEnt2
'Else
' Exit For
' End If End Sub Sub DIMtext()
Dim strPrmt As String
Dim objEnt As AcadEntity
Dim varPnt As Variant
Dim IsDimension As Boolean
Dim objDim As AcadDimension
Dim SS As AcadSelectionSet On Error Resume Next
strPrmt = vbCr & "选择标注对象:"
ThisDrawing.Utility.InitializeUserInput 1, "T A"
keyWord = ThisDrawing.Utility.GetKeyword _
("选择标注形式 (文字(T)/自动(A)): ")
ThisDrawing.Utility.Prompt strPrmt
ThisDrawing.SelectionSets.Item("SS1").Delete
Set SS = ThisDrawing.SelectionSets.Add("SS1")
SS.SelectOnScreen


SelfOverRide SS
ThisDrawing.Utility.Prompt "共选择尺寸标注" & m & "个," & "转换成功" & n & "个."
Exit Sub End Sub

雪山飞狐_lzh

有这样的例图么？贴一个上来看看？

jsyang_ren

图形是ＣＡＤ图


随便找一张复杂点的图都会出现这个问题　不能把所有标注转换为真实值　仍然显示＜＞


斑竹指教啊

jsyang_ren

我发现主要问题是出在标注文字的插入点和ＣＡＤ摸板空间中对应的ＭＴＥＸＴ文字块插入点不一样如何解决？？？ varPos = objEnt2.TextPosition 不等于 varInsPnt = objDimText.InsertionPoint
If varInsPnt(0) = varPos(0) Then
If varInsPnt(1) = varPos(1) Then

jsyang_ren

我想到了另一种方法，但是我不知道怎么找到尺寸文字标注的块名，例如ＬＩＳＰ里可以看到标注的文字块名　*Ｄ　在ＶＢＡ中如何找啊？？？？

雪山飞狐_lzh

可以试试Vlax类调用lisp代码实现，另外，源代码共享版有明总的方法，可以看看

jsyang_ren

我看到了，明总的方法和我的一样，也存在这个问题


我已经知道原因了，归纳了一下．


ＣＡＤ中的标注文字以块的形式存在于图中，为隐藏块．至于标注中的值就存在这些块里，例如*Ｄ４６等等，如果是自动标注，块里的文字仍然是真实值．每一个标注对应一个隐藏块，由于用户可能要拖动尺寸的控制点，所以ＣＡＤ并没有把标注中的文字与块中文字插入点等同起来．而是用块名去查找．


但是如果图中用到了外部引用块或是编辑过标注的属性，块中的文字插入点就和标注中文字插入点不一样，这时唯一的方法只能刷新图面，让图面重新计算坐标．单靠ＲＥＤＲＡＷ是不行的，必须让ＣＡＤ重绘．一切问题就可解决

jsyang_ren

如果哪为ＤＸ有新的见解，请多指教