[求助]帮看下这段代码

fjfhgdwfn 发表于 2006-5-8 12:08:00

主要功能是实现，在选中多个布局中的两个文字，在文字下方画线，同时修改颜色和大小
存在问题是，在选择文字时。很多时候选不上文字，但如果只有一个布局时，又可以选择上。多个布局时，很多布局上的选不上。
Sub Example_PaperUnits()     ' This example will access the Layouts collection for the current drawing     ' and list basic information about the paper units used for each Layout.
    Dim Layouts As AcadLayouts, Layout As AcadLayout    Dim ssetObj As AcadSelectionSet     Dim CONUT As Integer     Dim FilterType(1) As Integer    Dim FilterData(1) As Variant    Dim lend As Variant    Dim corner1(0 To 2) As Double     Dim corner2(0 To 2) As Double       Dim lineObj As AcadLine       ' Get layouts collection from document object     Set Layouts = ThisDrawing.Layouts     
       For Each Layout In Layouts             ThisDrawing.SetVariable "CTAB", Layout.Name       CONUT = 0     Count = ThisDrawing.SelectionSets.Count      For i = 0 To Count - 1 '删除所有的选择集     Set ssetObj = ThisDrawing.SelectionSets.Item(0)       ssetObj.Delete     Next i        ' ThisDrawing.ActiveSpace = acModelSpace                   Set ssetObj = ThisDrawing.SelectionSets.Add("sjx")           FilterType(0) = 0           FilterData(0) = "text"           FilterType(1) = 8           FilterData(1) = "TK_STA"              
          'ssetObj.Select acSelectionSetAll, , , FilterType, FilterData           ssetObj.Select acSelectionSetCrossing, corner1, corner2, FilterType, FilterData                     For Each entry In ssetObj           'MsgBox entry.TextString             lend = entry.TextAlignmentPoint                         corner1(0) = lend(0) + 20 * Cos(entry.Rotation): corner1(1) = lend(1) + 20 * Sin(entry.Rotation)             corner2(0) = lend(0) + 20 * Cos(entry.Rotation + 3.1415926): corner2(1) = lend(1) + 20 * Sin(entry.Rotation + 3.1415926)                  Set lineObj = ThisDrawing.PaperSpace.AddLine(corner1, corner2)            lineObj.color = 6            lineObj.Update            Count = 4            entry.Height = Count            entry.color = 6            entry.Update            Next entry           corner1(0) = 21: corner1(1) = 15: corner1(2) = 0          corner2(0) = 400: corner2(1) = 260: corner2(2) = 0             Next      'ThisDrawing.SetVariable "CTAB", Layout.Name
End Sub

xinghesnak 发表于 2006-5-8 14:18:00

ssetObj.Select acSelectionSetCrossing, corner1, corner2, FilterType, FilterData 之前怎么没见你给corner1，和corner2赋值？

fjfhgdwfn 发表于 2006-5-8 14:30:00

后边的也不行啊。同一个布局，根本就选不上。不过只要把其他的布局都删了，就可以了。
所有的布局都是一个程序自动生成的，如果你每一个布局都点一个就可以选取上了。要不一直是选取不上的。不知道如果解决。

页: [1]

明经CAD社区's Archiver

[求助]帮看下这段代码