[讨论]非常奇怪的现象，付源码
程序为把标注中的＜＞变为实际数值但是我在一些图中测试成功，但在一些复杂的图形中的标注无法完全把 标注中的＜＞变为实际数值
望高手指点，在线等～～～～～～～～～～～
Public keyWord As String<BR> Public m As Integer<BR> Public n As Integer<BR>Public Sub SelfOverRide(objDim As AcadSelectionSet)<BR> Dim objBlk As AcadBlock<BR> Dim objEnt As AcadEntity<BR> Dim objEnt2 As AcadEntity<BR> Dim varPos As Variant<BR> Dim varInsPnt As Variant<BR> Dim objDimText As AcadMText<BR> Dim objBlocks As AcadBlocks<BR> Dim blnDone As Boolean<BR> 'On Error Resume Next<BR> Set objBlocks = ThisDrawing.Blocks<BR> 'varPos = objDim.TextPosition<BR> 'For Each objBlk In objBlocks<BR> ' If Not blnDone Then<BR> m = 0<BR> n = 0<BR> For Each objEnt2 In objDim<BR> If TypeOf objEnt2 Is AcadDimension Then<BR> varPos = objEnt2.TextPosition<BR> m = m + 1<BR> For Each objBlk In objBlocks<BR> If Left(objBlk.Name, 2) = "*D" Then<BR> For Each objEnt In objBlk<BR> If TypeOf objEnt Is AcadMText Then<BR> Set objDimText = objEnt<BR> varInsPnt = objDimText.InsertionPoint<BR> If varInsPnt(0) = varPos(0) Then<BR> If varInsPnt(1) = varPos(1) Then<BR> If keyWord = "T" Then<BR> objEnt2.TextOverride = objDimText.TextString<BR> Else<BR> objEnt2.TextOverride = "<>"<BR> End If<BR> n = n + 1<BR> Exit For<BR> End If<BR> End If<BR> End If<BR> Next objEnt<BR> End If<BR> Next objBlk<BR> End If<BR> Next objEnt2<BR> 'Else<BR> ' Exit For<BR> ' End If
End Sub
Sub DIMtext()<BR> Dim strPrmt As String<BR> Dim objEnt As AcadEntity<BR> Dim varPnt As Variant<BR> Dim IsDimension As Boolean<BR> Dim objDim As AcadDimension<BR> Dim SS As AcadSelectionSet
On Error Resume Next<BR> strPrmt = vbCr & "选择标注对象:"<BR> ThisDrawing.Utility.InitializeUserInput 1, "T A"<BR> keyWord = ThisDrawing.Utility.GetKeyword _<BR> ("选择标注形式 (文字(T)/自动(A)): ")<BR> ThisDrawing.Utility.Prompt strPrmt<BR> ThisDrawing.SelectionSets.Item("SS1").Delete<BR> Set SS = ThisDrawing.SelectionSets.Add("SS1")<BR> SS.SelectOnScreen<BR> <BR> <BR> SelfOverRide SS<BR> ThisDrawing.Utility.Prompt "共选择尺寸标注" & m & "个," & "转换成功" & n & "个."<BR> Exit Sub
End Sub
有这样的例图么？贴一个上来看看？ 图形是ＣＡＤ图
随便找一张复杂点的图都会出现这个问题 不能把所有标注转换为真实值 仍然显示＜＞
斑竹指教啊 我发现主要问题是出在标注文字的插入点和ＣＡＤ摸板空间中对应的ＭＴＥＸＴ文字块插入点不一样如何解决？？？
varPos = objEnt2.TextPosition
不等于
varInsPnt = objDimText.InsertionPoint<BR> If varInsPnt(0) = varPos(0) Then<BR> If varInsPnt(1) = varPos(1) Then<BR> 我想到了另一种方法，但是我不知道怎么找到尺寸文字标注的块名，例如ＬＩＳＰ里可以看到标注的文字块名 *Ｄ 在ＶＢＡ中如何找啊？？？？ 可以试试Vlax类调用lisp代码实现，另外，源代码共享版有明总的方法，可以看看 我看到了，明总的方法和我的一样，也存在这个问题
我已经知道原因了，归纳了一下．
ＣＡＤ中的标注文字以块的形式存在于图中，为隐藏块．至于标注中的值就存在这些块里，例如*Ｄ４６等等，如果是自动标注，块里的文字仍然是真实值．每一个标注对应一个隐藏块，由于用户可能要拖动尺寸的控制点，所以ＣＡＤ并没有把标注中的文字与块中文字插入点等同起来．而是用块名去查找．
但是如果图中用到了外部引用块或是编辑过标注的属性，块中的文字插入点就和标注中文字插入点不一样，这时唯一的方法只能刷新图面，让图面重新计算坐标．单靠ＲＥＤＲＡＷ是不行的，必须让ＣＡＤ重绘．一切问题就可解决 如果哪为ＤＸ有新的见解，请多指教
页:
[1]