简单的问题
在下面的代码中，我在删除并重新插入一些文本后重新生成。在删除文本或重新生成之前（在下一次运行之前的代码末尾），程序正在读取extmin变量，这意味着插入的文本高度比上一次低一个文本高度。目标是始终将其插入extmin下方相同的y维度。如果我在图形中手动执行删除和重新生成并运行代码，它将按我所希望的方式工作。在代码中执行这些功能似乎是无效的。
提前感谢
下面列出了部分代码。。。
Dim minext As Variant
minext = ThisDrawing.GetVariable("EXTMIN")
Dim min(0 To 2) As Double
min(0) = minext(0)
min(1) = minext(1)
min(2) = minext(2)
Dim ip(0 To 2) As Double
ip(0) = min(0)
ip(1) = min(1) + negret(h * 1.3)
ip(2) = 0
' Check for Text String at coordinates and delete - Option 2
Dim objDataBase As AcadDatabase
Dim objBlock As AcadBlock
Dim Ent As AcadEntity
Dim c As Integer
Dim i As Integer
Dim entCollection As Collection
Dim varHandle As Variant
Set entCollection = New Collection
For Each objBlock In ThisDrawing.Blocks
c = objBlock.Count
For i = 0 To c - 1
If TypeOf objBlock.Item(i) Is AcadEntity Then
If objBlock.Item(i).Layer = "FILEPATHTEXT" Then
entCollection.Add (objBlock.Item(i).Handle)
End If
End If
Next
On Error Resume Next
For Each varHandle In entCollection
Set Ent = ThisDrawing.HandleToObject(CStr(varHandle))
Ent.Delete
Next
On Error GoTo 0
Next
' Regen after deletion
ThisDrawing.SendCommand "ZOOM" & vbCr & "EXTENTS"
ThisDrawing.Regen acActiveViewport
' Add Text String
Dim dir As String
dir = ThisDrawing.GetVariable("DWGPREFIX")
Dim fil As String
fil = ThisDrawing.GetVariable("DWGNAME")
Dim objText2 As AcadText
Dim textString As String
textString = dir & fil
Set objText2 = ThisDrawing.ModelSpace.AddText(textString, ip, h)
页:
[1]