找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 2429|回复: 2

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

[复制链接]
发表于 2014-4-10 22:59:07 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
请问,下面代码的过滤器怎么无效啊?
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

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 1268个

财富等级: 财源广进

发表于 2014-4-11 12:23:08 来自手机 | 显示全部楼层
-4 是lisp ssget用法,VBA的过滤没有-4部分,应该在循环里再判断
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2014-4-11 20:11:52 | 显示全部楼层
那个过滤器在没有加下面代码前是正常的:
filterType1(3) = 410
    filterData1(3) = ActiveDocument.ActiveLayout.Name
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-5 14:53 , Processed in 0.406587 second(s), 35 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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