vla方法过滤图元

dcl1214

1. (defun $ssget-vla$ (pt1 pt2 filter lst / ss-n ss tmp ents e)
   
2.           ;vla选择集
   
3. ;示例 ：($ssget-vla$ (getpoint)(getpoint)(list(cons 0 "*LINE*"))nil)
   
4.   (setq ss-n "SSGET")
   
5.   (if filter
   
6.     (progn
   
7.       (vl-Catch-All-Apply
   
8.   'vla-delete
   
9.   (LIST
   
10.     (vl-Catch-All-Apply
    
11.       'vla-item
    
12.       (list (vla-get-SelectionSets
    
13.         (vla-get-ActiveDocument (vlax-get-acad-object))
    
14.       )
    
15.       ss-n
    
16.       )
    
17.     )
    
18.   )
    
19.       )
    
20.       (setq
    
21.   ss (vl-Catch-All-Apply
    
22.        'vla-add
    
23.        (list (vla-get-selectionsets
    
24.          (vla-get-activedocument (vlax-get-acad-object))
    
25.        )
    
26.        ss-n
    
27.        )
    
28.      )
    
29.       )
    
30.       (setq
    
31.   tmp (mapcar
    
32.         (function
    
33.     (lambda  (x y)
    
34.       (vl-catch-all-apply
    
35.         'vlax-make-variant
    
36.         (list (vl-catch-all-apply
    
37.           'vlax-safearray-fill
    
38.           (list (vl-Catch-All-Apply
    
39.             'vlax-make-safearray
    
40.             (list y (cons 0 (1- (length x))))
    
41.           )
    
42.           x
    
43.           )
    
44.         )
    
45.         )
    
46.       )
    
47.     )
    
48.         )
    
49.         (list (mapcar 'car filter) (mapcar 'cdr filter))
    
50.         (list vlax-vbInteger vlax-vbVariant)
    
51.       )
    
52.       )
    
53.       (if (and pt1 pt2)
    
54.   (progn
    
55.     (setq pt1 (list (car pt1) (cadr pt1) 0))
    
56.     (setq pt2 (list (car pt2) (cadr pt2) 0))
    
57.     (vl-catch-all-apply
    
58.       'vla-select
    
59.       (list
    
60.         ss
    
61.         acSelectionSetCrossing
    
62.         (vlax-3d-point pt1)
    
63.         (vlax-3d-point pt2)
    
64.         (car TMP)
    
65.         (cadr TMP)
    
66.       )
    
67.     )
    
68.   )
    
69.   (vl-catch-all-apply
    
70.     'vla-select
    
71.     (list
    
72.       ss
    
73.       acSelectionSetAll
    
74.       nil
    
75.       nil
    
76.       (car TMP)
    
77.       (cadr TMP)
    
78.     )
    
79.   )
    
80.       )
    
81.     )
    
82.   )
    
83.   (setq ents nil)
    
84.   (if ss
    
85.     (VLAX-FOR obj ss
    
86.       (setq e (vlax-vla-object->ename obj))
    
87.       (setq ents (cons e ents))
    
88.     )
    
89.   )
    
90.   (setq ss nil)
    
91.   ENTS
    
92. )

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

tigcat

难道用在DBX?

llsheng_73

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

DBX不支持select方法

llsheng_73

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

-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

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

你有种再说一遍

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

masterlong

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

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

xyp1964

能比选择易高效和省事？