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

风魔飘香 发表于 2003-10-31 14:28:00

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

efan2000 发表于 2003-10-31 18:53:00

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

myfreemind 发表于 2003-10-31 23:47:00

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

风魔飘香 发表于 2003-11-3 09:20:00

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 发表于 2003-11-3 09:54:00

给你这段没有问题的。
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

风魔飘香 发表于 2003-11-3 10:07:00

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

风魔飘香 发表于 2003-11-3 10:11:00

有问题的代码如下：
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这句话出错。

风魔飘香 发表于 2003-11-3 10:12:00

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

mccad 发表于 2003-11-3 11:21:00

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

风魔飘香 发表于 2003-11-3 16:41:00

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

页: [1] 2

明经CAD社区's Archiver

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