拒绝遍历，请进！VLA-SELECT的过滤器！功能是相当的强大

zark · 发表于 2011-4-9 22:22

;程序是获取‘（-100000,-100000）到 ‘（10000000，10000000）之间的所有圆。
;请高手改进一下关键函数
;1、模式由原来的acSelectionSetCrossing 改成 acSelectionSetAll （如果这个不改就算了，反正能再实现以下功能就行
;2、下例是选择所有圆，现在能否改成选择所有“0”层的对象？
;3、能否再改能选择“0”层并且是“块”的对象。
;;;本人不会VAB，看了相关函数也参透不出其中的奥妙，请大侠们指点指点，能解决这三个问题中的一个也行，谢谢你的参与！
(defun c:test (/ ACADDOCUMENT    ACADOBJECT
      CORNER1 CORNER2    DATAVALUE GPCODE
      MODE MSPACE    SSETOBJ
   )
  (vl-load-com)
  (setq acadobject (vlax-get-acad-object)
acaddocument (vla-get-activedocument acadobject)
mspace    (vla-get-modelspace acaddocument)
  )
  (setq ssetobj (vla-add (vla-get-selectionsets acaddocument) "sset"))
  (setq mode acSelectionSetCrossing)
  (setq corner1 (vlax-3d-point (list -10000000.0 -10000000.0 0)))
  (setq corner2 (vlax-3d-point (list 10000000.0 10000000.0 0)))
  (setq gpcode (vlax-make-safearray vlax-vbinteger '(0 . 0)))
  (vlax-safearray-put-element gpcode 0 0)
  (setq datavalue (vlax-make-safearray vlax-vbvariant '(0 . 0)))
  (vlax-safearray-put-element datavalue 0 "CIRCLE")
  (vla-select ssetobj mode corner1 corner2 gpcode datavalue)
  (princ)
)

lisp爱好者 · 发表于 2011-4-10 13:30

看不懂

，没学过VL函数

zark · 发表于 2011-4-9 22:24

如果大家在调试过程中出现 ; 错误: Automation 错误。命名选择集已存在
请将"sset" 改为 (rtos (getvar "cdate") 2 10)

zark · 发表于 2011-4-10 01:17

;终于解决了，从此跟遍历说88
(defun ax:BuildFilter (filter)
  (vl-load-com)
  (mapcar '(lambda (lst typ)
      (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray typ (cons 0 (1- (length lst)))) lst))
   )
   (list (mapcar 'car filter) (mapcar 'cdr filter))
   (list vlax-vbInteger vlax-vbVariant)
  )
)

(defun c:test (/    ACADDOCUMENT    ACADOBJECT
         CORNER1    CORNER2    DATAVALUE GPCODE
         MODE    MSPACE    ssetobj    tmp
      )
  (vl-load-com)
  (setq acadobject (vlax-get-acad-object)
acaddocument (vla-get-activedocument acadobject)
mspace       (vla-get-modelspace acaddocument)
  )
  (setq ssetobj (vla-add (vla-get-selectionsets acaddocument) (rtos (getvar "cdate") 2 10)))
  (setq mode acSelectionSetAll)
  (setq tmp (ax:BuildFilter '((8 . "tk") (2 . "ac50tk"))))
  (vla-select ssetobj mode nil nil  (car TMP) (cadr TMP))
  (setq t3 ssetobj)
)

caoyin · 发表于 2011-4-10 22:11

本帖最后由 caoyin 于 2011-4-10 22:13 编辑

回复 zark 的帖子
“如果大家在调试过程中出现 ; 错误: Automation 错误。命名选择集已存在
请将"sset" 改为 (rtos (getvar "cdate") 2 10)”

太多选集会占用系统资源，不如Clear

zark · 发表于 2011-4-11 12:57

回复 caoyin 的帖子

嗯。很好的建议，但是盲目的考虑怎么不让他重复。版主，我这个功能主能用在打开图的情况下拒绝遍历，还是没办法在后台打开的窗口里使用

，因为文件数据里找不到SELECTIONSET这项，所以没办法定义选择集。不懂你有何高见

Gu_xl · 发表于 2011-4-11 13:48

回复 lisp爱好者的帖子

选择集超过128个，程序会出错的！请先清除当前选择集后使用当前选择集！(setq ssobj(vla-get-ActiveSelectionSet （vla-get-activedocument (vlax-get-acad-object))))

zark · 发表于 2011-4-11 17:55

很好，也可以节省内存

caoyin · 发表于 2011-4-11 21:11

本帖最后由 caoyin 于 2011-4-11 21:14 编辑

“终于解决了，从此跟遍历说88”

这种方法优点是快，缺点是无法处理块内的套嵌对象

“因为文件数据里找不到SELECTIONSET这项，所以没办法定义选择集”
在DBX中不行是预料之中的事情，还有一个思路：（只对块操作有效）
就是对打开的DBX档中的ac50tk块进行遍历，重新定义。。。。

zark · 发表于 2011-4-12 00:25

回复 caoyin 的帖子

是呀，不打开确实很快，光就字体替换就省下来了。如果能通过过滤器来快速找到他那是很不错，

账号		自动登录	找回密码
密码			注册

[函数] 拒绝遍历，请进！VLA-SELECT的过滤器！功能是相当的强大