明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1329|回复: 0

请问,下面代码的过滤器怎么无效啊?

[复制链接]
发表于 2014-4-10 22:58:10 | 显示全部楼层 |阅读模式
请问,下面代码的过滤器怎么无效啊?
Private Sub CommandButton515_Click()
'注意图元色值须为红色1才有效,还须注意随层时,它虽然是红色,色值仍是256,而不是1
'‘按单行文字的数学X值编页码的宏
  Dim x, y, i
  Dim VVV
  Dim ZRR() As Variant
  Dim QZ, QY, QJ, TEMP1, TEMP2, TEMP3, XH, k
  ''来源:[原创]给text加框的程序-VBA/VB/ActiveX/API 编程技术-CAD论坛-明经CAD社区 - Powered by Discuz!
'http://bbs.mjtd.com/forum.php?mod=viewthread&tid=77184
'    On Error Resume Next
   Dim mypnt1 As Variant
  Dim mypnt2  As Variant
    Rem mypnt1 = ThisDrawing.Utility.GetPoint(, "请选择左下角点:")
    Rem mypnt2 = ThisDrawing.Utility.GetCorner(mypnt1, "请选择右上角点:")
'crossing 方法选择所有内部对象
    Dim sset1 As AcadSelectionSet
    If Not IsNull(ThisDrawing.SelectionSets.Item("SS1")) Then
        Set sset1 = ThisDrawing.SelectionSets.Item("SS1")
        sset1.Delete
    End If
    Set sset1 = ThisDrawing.SelectionSets.Add("SS1")
'定义过滤规则
    Dim filterType1(0 To 4) As Integer
    Dim filterData1(0 To 4) As Variant


    filterType1(0) = -4
    filterData1(0) = "<AND"
    filterType1(1) = 0
    filterData1(1) = "TEXT"
     filterType1(2) = 8
    filterData1(2) = "0第几页"
    filterType1(3) = 410
    filterData1(3) = ActiveDocument.ActiveLayout.Name
    filterType1(4) = -4
    filterData1(4) = "AND>"

    Rem sset1.Select acSelectionSetCrossing, mypnt1, mypnt2, filterType1, filterData1 ' 使用Crossing选择模式,选择内部所有对象(包含边界本身)
    sset1.Select acSelectionSetAll, , , filterType1, filterData1  ' 使用Crossing选择模式,选择内部所有对象(包含边界本身)
    Dim ADTEXT As AcadText
    Dim MINPT As Variant
    Dim MAXPT As Variant
    Dim RECPL As AcadLWPolyline
    For Each ADTEXT In sset1
'是红色才处理的代码
'  If ADTEXT.color = 1 Then
  k = k + 1
    ReDim Preserve ZRR(1 To 4, 1 To k)
    '下面是将数组X由小到大排序
       Set ZRR(1, k) = ADTEXT
   ZRR(2, k) = ADTEXT.InsertionPoint(0)
    ZRR(3, k) = ADTEXT.InsertionPoint(1)
'  End If

'ADTEXT.TextString = Replace(ADTEXT.TextString, 1, 9)
'        ADTEXT.GetBoundingBox MINPT, MAXPT'获得方框的两角点坐标
'        Set RECPL = AddRectangle(MINPT, MAXPT)'画方框
    Next
ZRR = 数组排序2维第1参数1行降2013年4月19日(ZRR, 3)


'下面是给Y值相等或相近的文字编同一组号
y = LBound(ZRR, 1)
    x = LBound(ZRR, 2)
For i = x To UBound(ZRR, 2)
            If i = y Then
            ZRR(4, i) = 1
            GoTo 下一个循环
            End If
            If (ZRR(3, i - 1) - ZRR(3, i)) > (TextBox7.Value * 1) Then
            ZRR(4, i) = ZRR(4, i - 1) + 1
            Else
            ZRR(4, i) = ZRR(4, i - 1)
            End If
下一个循环:
        Next i
    ZRR = 数组排序2维第1参数2行升升2013年4月19日(ZRR, 4, 2)


    '再下面是将排序后的单行文本填为页码
XH = TextBox5.Value * 1
    For i = x To UBound(ZRR, 2)
          VVV = VVV + 1
          ZRR(1, i).TextString = VVV + XH - 1

        Next i





'这是因为最后一次经过了NEXT,QZ增加了一位
TextBox6.Value = VVV + XH - 1
  TextBox5.Value = VVV + XH - 1 + 1
End Sub


您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-25 12:39 , Processed in 0.153250 second(s), 24 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表