一个很郁闷的问题。关于求文本宽度的。

风魔飘香

在对Text对象执行GetBoundingBox方法时，居然提示“Invalid extents"错误。什么意思呀？Text对象应该是可以使用GetBoundingBox方法的呀。请老大们指教。

efan2000

从错误的说明来看，应该跟图纸界限设置有关系吧，是否文本位于界限之外。

myfreemind

把你的代码帖上来看看问题出在哪里!

风魔飘香

Dim strText As String
    Dim oEntity As AcadEntity
    Dim oText As AcadText
    Dim bFound As Boolean
    Dim typeFace As String
    Dim Bold As Boolean
    Dim Italic As Boolean
    Dim charSet As Long
    Dim PitchandFamily As Long
    Dim InsertPoint(2) As Double
    Dim height As Double
   
    strText = InputBox("请输入需要查找的文字！")
   
    bFound = False
   
    For Each oEntity In oDoc.ModelSpace
        If oEntity.ObjectName = "AcDbText" Then
            Set oText = oDoc.ModelSpace.Item(i)
            DoEvents
            
            If LCase(oText.TextString) = strText Then
                height = 1
            
                InsertPoint(0) = oText.InsertionPoint(0) + 5
                InsertPoint(1) = oText.InsertionPoint(1) - (height + 5)
                InsertPoint(2) = oText.InsertionPoint(2)
               
                oDoc.ActiveTextStyle.GetFont typeFace, Bold, Italic, charSet, PitchandFamily
                oDoc.ActiveTextStyle.SetFont "宋体", False, False, charSet, PitchandFamily
            
                Set oText = oDoc.ModelSpace.AddText("测试", InsertPoint, height)
               
                oText.Update
            End If
        End If
        
        DoEvents
        
        i = i + 1
    Next
   
    MsgBox "OK!"

gzy

给你这段没有问题的。
Sub textfont()
Dim typeface As String
Dim textbold As Boolean
Dim textitalic As Boolean
Dim textcharset As Long
Dim textpfamily As Long
ThisDrawing.ActiveTextStyle.GetFont typeface, _
textbold, textitalic, textcharset, textpfamily

MsgBox "当前字体为:" & typeface

typeface = "隶书"
ThisDrawing.ActiveTextStyle.SetFont typeface, _
textbold, textitalic, textcharset, textpfamily
ThisDrawing.Regen acActiveViewport

Dim textobj As AcadText
Dim textstring As String
Dim textheight As Double
Dim inspoint(0 To 2) As Double

textstring = "关章洋"
inspoint(0) = 10
inspoint(1) = 10
inspoint(2) = 0
textheight = 5
Set textobj = ThisDrawing.ModelSpace.AddText(textstring, inspoint, textheight)

End Sub

风魔飘香

to gzy,to All:
     sorry,贴错了，这段代码没有问题。:)

风魔飘香

有问题的代码如下：
    Dim strText As String
    Dim oEntity As AcadEntity
    Dim oText As AcadText
    Dim bFound As Boolean
    Dim typeFace As String
    Dim Bold As Boolean
    Dim Italic As Boolean
    Dim charSet As Long
    Dim PitchandFamily As Long
    Dim minPoint As Variant, maxpoint As Variant
    Dim InsertPoint(2) As Double
    Dim height As Double
   
    strText = InputBox("请输入需要查找的文字！")
   
    bFound = False
   
    For Each oEntity In oDoc.ModelSpace
        If oEntity.ObjectName = "AcDbText" Then
            Set oText = oDoc.ModelSpace.Item(i)
            DoEvents
            
            If LCase(oText.TextString) = strText Then
                oText.GetBoundingBox minPoint, maxpoint
                height = 1
            
                InsertPoint(0) = maxPoint(0) + 5
                InsertPoint(1) = maxPoint(1) - (height + 5)
                InsertPoint(2) = maxPoint(2)
               
                oDoc.ActiveTextStyle.GetFont typeFace, Bold, Italic, charSet, PitchandFamily
                oDoc.ActiveTextStyle.SetFont "宋体", False, False, charSet, PitchandFamily
            
                Set oText = oDoc.ModelSpace.AddText("朱震宇", InsertPoint, height)
               
                oText.Update
            End If
        End If
        
        DoEvents
        
        i = i + 1
    Next
   
    MsgBox "OK!"

'关键是oText.GetBoundingBox minPoint, maxpoint这句话出错。

风魔飘香

其实我的要求很简单，要么能通过GetBoundingBox获取文本的相应坐标，要么能获取文本的宽度。哪位老大帮帮忙？

mccad

你的程序我试过了，没有出现问题。能顺利通过调试。不管文字是否在屏幕范围内都可以。

风魔飘香

to mccad:
　　对了，我在打开这张dwg图时，发现通过VB调用Acad COM打开的AutoCAD2002窗口中所有的Text元素都不显示，而直接打开AutoCAD时却时显示。是不是和没有字体有关？因为在打开直接AutoCAD时，提示要求选择字体。而在通过VB调用COM接口时我没有指定相应的字体，有这个可能吗？