[求助]：怎样改AcDbText的字宽

chenlei

即dtext写的字的字宽，不是mtext的字宽。
set t as acadtext
其中 t 没有width属性。

efan2000

AcDbText是单行文字，所以就没有字宽，如果要取得文字的宽度，可以用GetBoundingBox方法获取文字在水平位置时所处的左下角坐标和右上角坐标，计算出长度。最后，如果文字设置了ScaleFactor，可以先计算出长度，再乘以这个系数。

chenlei

我说的字宽指的是字的宽高比，缺省是1，在textstyle中修改后，mtext文字会自动改，而dtext的文字不会自已改，要一个一个手动改。怎样写个程序一下改掉。

efan2000

附上程序，试试，按你的做法自己去加以改进。

2. 
   
3.   [FONT=courier new]
   
4. Sub Test()
   
5.     On Error Resume Next
   
6.     Dim SSetObj As AcadSelectionSet
   
7.     Set SSetObj = ThisDrawing.SelectionSets("ScaleFactor")
   
8.     If Err.Number <> 0 Then
   
9.         Err.Clear
   
10.         Set SSetObj = ThisDrawing.SelectionSets.Add("ScaleFactor")
    
11.     End If
    
12.     SSetObj.Clear
    
13.     Dim fType(0 To 0) As Integer
    
14.     Dim fData(0 To 0) As Variant
    
15.     fType(0) = 0
    
16.     fData(0) = "TEXT"
    
17.     SSetObj.SelectOnScreen fType, fData
    
18.     If SSetObj.Count = 0 Then Exit Sub
    
19.     Dim sf As Double
    
20.     sf = ThisDrawing.Utility.GetReal("请输入宽度比例: ")
    
21.     Dim i As Integer
    
22.     For i = 0 To SSetObj.Count - 1
    
23.         SSetObj(i).ScaleFactor = sf
    
24.     Next
    
25.     Set SSetObj = Nothing
    
26. End Sub
    
27.   [/FONT]
    

<br />   [FONT=courier new]<br /> Sub Test()<br />     On Error Resume Next<br />     Dim SSetObj As AcadSelectionSet<br />     Set SSetObj = ThisDrawing.SelectionSets("ScaleFactor")<br />     If Err.Number <> 0 Then<br />         Err.Clear<br />         Set SSetObj = ThisDrawing.SelectionSets.Add("ScaleFactor")<br />     End If<br />     SSetObj.Clear<br />     Dim fType(0 To 0) As Integer<br />     Dim fData(0 To 0) As Variant<br />     fType(0) = 0<br />     fData(0) = "TEXT"<br />     SSetObj.SelectOnScreen fType, fData<br />     If SSetObj.Count = 0 Then Exit Sub<br />     Dim sf As Double<br />     sf = ThisDrawing.Utility.GetReal("请输入宽度比例: ")<br />     Dim i As Integer<br />     For i = 0 To SSetObj.Count - 1<br />         SSetObj(i).ScaleFactor = sf<br />     Next<br />     Set SSetObj = Nothing<br /> End Sub<br />   [/FONT]<br />

chenlei

ScaleFactor 这到确实提醒了我，先试一下，谢谢了。