vla方法过滤图元

dcl1214 · 发表于 2024-1-1 15:39:33

本帖最后由 dcl1214 于 2024-1-1 15:40 编辑

(defun $ssget-vla$ (pt1 pt2 filter lst / ss-n ss tmp ents e)
;vla选择集
;示例：($ssget-vla$ (getpoint)(getpoint)(list(cons 0 "*LINE*"))nil)
(setq ss-n "SSGET")
(if filter
(progn
(vl-Catch-All-Apply
'vla-delete
(LIST
(vl-Catch-All-Apply
'vla-item
(list (vla-get-SelectionSets
(vla-get-ActiveDocument (vlax-get-acad-object))
)
ss-n
)
)
)
)
(setq
ss (vl-Catch-All-Apply
'vla-add
(list (vla-get-selectionsets
(vla-get-activedocument (vlax-get-acad-object))
)
ss-n
)
)
)
(setq
tmp (mapcar
(function
(lambda (x y)
(vl-catch-all-apply
'vlax-make-variant
(list (vl-catch-all-apply
'vlax-safearray-fill
(list (vl-Catch-All-Apply
'vlax-make-safearray
(list y (cons 0 (1- (length x))))
)
x
)
)
)
)
)
)
(list (mapcar 'car filter) (mapcar 'cdr filter))
(list vlax-vbInteger vlax-vbVariant)
)
)
(if (and pt1 pt2)
(progn
(setq pt1 (list (car pt1) (cadr pt1) 0))
(setq pt2 (list (car pt2) (cadr pt2) 0))
(vl-catch-all-apply
'vla-select
(list
ss
acSelectionSetCrossing
(vlax-3d-point pt1)
(vlax-3d-point pt2)
(car TMP)
(cadr TMP)
)
)
)
(vl-catch-all-apply
'vla-select
(list
ss
acSelectionSetAll
nil
nil
(car TMP)
(cadr TMP)
)
)
)
)
)
(setq ents nil)
(if ss
(VLAX-FOR obj ss
(setq e (vlax-vla-object->ename obj))
(setq ents (cons e ents))
)
)
(setq ss nil)
ENTS
)

(defun $ssget-vla$ (pt1 pt2 filter lst / ss-n ss tmp ents e) 
          ;vla选择集 
;示例 ：($ssget-vla$ (getpoint)(getpoint)(list(cons 0 "*LINE*"))nil) 
  (setq ss-n "SSGET") 
  (if filter 
    (progn 
      (vl-Catch-All-Apply 
  'vla-delete 
  (LIST 
    (vl-Catch-All-Apply 
      'vla-item 
      (list (vla-get-SelectionSets 
        (vla-get-ActiveDocument (vlax-get-acad-object)) 
      ) 
      ss-n 
      ) 
    ) 
  ) 
      ) 
      (setq 
  ss (vl-Catch-All-Apply 
       'vla-add 
       (list (vla-get-selectionsets 
         (vla-get-activedocument (vlax-get-acad-object)) 
       ) 
       ss-n 
       ) 
     ) 
      ) 
      (setq 
  tmp (mapcar 
        (function 
    (lambda  (x y) 
      (vl-catch-all-apply 
        'vlax-make-variant 
        (list (vl-catch-all-apply 
          'vlax-safearray-fill 
          (list (vl-Catch-All-Apply 
            'vlax-make-safearray 
            (list y (cons 0 (1- (length x)))) 
          ) 
          x 
          ) 
        ) 
        ) 
      ) 
    ) 
        ) 
        (list (mapcar 'car filter) (mapcar 'cdr filter)) 
        (list vlax-vbInteger vlax-vbVariant) 
      ) 
      ) 
      (if (and pt1 pt2) 
  (progn 
    (setq pt1 (list (car pt1) (cadr pt1) 0)) 
    (setq pt2 (list (car pt2) (cadr pt2) 0)) 
    (vl-catch-all-apply 
      'vla-select 
      (list 
        ss 
        acSelectionSetCrossing 
        (vlax-3d-point pt1) 
        (vlax-3d-point pt2) 
        (car TMP) 
        (cadr TMP) 
      ) 
    ) 
  ) 
  (vl-catch-all-apply 
    'vla-select 
    (list 
      ss 
      acSelectionSetAll 
      nil 
      nil 
      (car TMP) 
      (cadr TMP) 
    ) 
  ) 
      ) 
    ) 
  ) 
  (setq ents nil) 
  (if ss 
    (VLAX-FOR obj ss 
      (setq e (vlax-vla-object->ename obj)) 
      (setq ents (cons e ents)) 
    ) 
  ) 
  (setq ss nil) 
  ENTS 
)

tigcat · 发表于 2024-1-1 19:25:46

难道用在DBX?

llsheng_73 · 发表于 2024-1-1 19:35:36

tigcat 发表于 2024-1-1 19:25
难道用在DBX?

DBX不支持select方法

llsheng_73 · 发表于 2024-1-1 19:44:01

本帖最后由 llsheng_73 于 2024-1-1 19:59 编辑

vla的select方法比较麻烦，模式较多：Window、Crossing、Previous、Last、All，虽然有这么多mode，实际使用起来远远不够，更多的情况还需要使用 SelectByPolygon, SelectAtPoint, SelectOnScreen方法。但各种方法模式不相同，导致不太容易直接按ssget函数习惯去匹配适用的方法和模式，当然也不是完全不可能，只是特别麻烦，更麻烦的是-3组，因为-3组是一个大项，需要专门组建数据和其它组结合在一起才能进行有效过滤....再加上ssget函数常用到的-4组，过滤表整合起来比较累人
另外，对于选择集，很多时候都是创建一个命名选择集，但循环调用不注意间可能导致选择集数量超限(128),一般情况下可以直接使用activeselectionset，
(vlax-get-property(vlax-get-property(vlax-get-acad-object)'activedocument)'activeselectionset)

masterlong · 发表于 2024-1-1 21:35:43

-4倒是简单
和其它的组码代号没啥区别

;;全图搜索非250色的“TK-*”图框
(setq ssets (vla-get-selectionsets *doc*))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list ssets "$Set")))
(setq alltkset (vla-add ssets "$Set"))
(progn
(vla-delete (vla-item ssets "$Set"))
(setq alltkset (vla-add ssets "$Set"))
)
)
(setq filter_code (vlax-make-safearray vlax-vbinteger '(0 . 3)))
(setq filter_value (vlax-make-safearray vlax-vbvariant '(0 . 3)))
(vlax-safearray-fill filter_code '(0 2 -4 62))
(vlax-safearray-fill filter_value '("insert" "TK-*" "!=" 250))
(vla-Select alltkset acSelectionSetAll nil nil filter_code filter_value)

masterlong · 发表于 2024-1-1 21:39:49

vla选择集有一点很好玩
写外部块的时候
它同时输出模型和布局里的内容

你有种再说一遍 · 发表于 2024-1-2 16:56:46

给迷途羔羊一条路,后台获取数据制造索引和八叉树就是选择集了,至于你会不会,至少我在lisp没看到人敲这个

masterlong · 发表于 2024-1-2 22:28:39

很多人别说8叉树
4叉树或者2叉树是啥都不知道
比如我

所以
楼上用lisp写个？
大家都来学习下

xyp1964 · 发表于 2024-1-2 22:53:53

能比选择易高效和省事？

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

[源码] vla方法过滤图元

评分