Topic: Help with Selection Set

[polhub]

Ronjonp wrote this awsome bit of code. Each SL-WIRE-FLAG block has a line associated with it, the question is,  how would I go about adding a line to the selection set, is it part of the DXF code or is it a separate selection set altogether?

Code - Auto/Visual Lisp: [Select]

1. (defun c:foo (/ a b bp c l mp p p1 p2 s x x1 x2 y y1 y2 _x _y)
2.   ;; RJP - 11.15.2017
3.   (if (and (setq p1 (getpoint "\nSpecify first corner: "))
4.            (setq p2 (getcorner p1 "\nSpecify opposite corner:"))
5.            (setq l (list p1 p2))
6.            (setq l (list (apply 'mapcar (cons 'min l)) (apply 'mapcar (cons 'max l))))
7.            (setq s (ssget "_C" p1 p2 '((0 . "insert") (2 . "`*U*,SL-WIRE-FLAG"))))
8.            (setq p
9.                   (mapcar
10.                     '(lambda (x)
11.                        (if (setq p1 (vl-remove-if-not
12.                                       '(lambda (c) (wcmatch (strcase (vla-get-propertyname c)) "POSITION*"))
13.                                       (vlax-invoke x 'getdynamicblockproperties)
14.                                     )
15.                            )
16.                          (list (vl-sort p1
17.                                         '(lambda (a b) (< (vla-get-propertyname a) (vla-get-propertyname b)))
18.                                )
19.                                (vlax-get x 'insertionpoint)
20.                          )
21.                        )
22.                      )
23.                     (vl-remove-if-not
24.                       '(lambda (d) (vlax-write-enabled-p d))
25.                       (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
26.                     )
27.                   )
28.            )
29.            (setq bp (getpoint "\nSpecify base point: "))
30.            (setq mp (getpoint bp "\nSpecify second point: "))
31.       )
32.     (foreach x (vl-remove 'nil p)
33.       (mapcar 'set '(x1 y1 x2 y2) (mapcar '(lambda (y) (vlax-get y 'value)) (setq c (car x))))
34.       (setq _x (car (cadr x)))
35.       (setq _y (cadr (cadr x)))
36.       (if (setq a (cond ((and (<= (car (mapcar 'car l)) (+ _x x1) (cadr (mapcar 'car l)))
37.                               (<= (car (mapcar 'cadr l)) (+ _y y1) (cadr (mapcar 'cadr l)))
38.                          )
39.                          (list (car c) (cadr c) (list x1 y1))
40.                         )
41.                         ((and (<= (car (mapcar 'car l)) (+ _x x2) (cadr (mapcar 'car l)))
42.                               (<= (car (mapcar 'cadr l)) (+ _y y2) (cadr (mapcar 'cadr l)))
43.                          )
44.                          (list (caddr c) (cadddr c) (list x2 y2))
45.                         )
46.                   )
47.           )
48.         (progn (setq b (polar (last a) (angle bp mp) (distance bp mp)))
49.                (vlax-put (car a) 'value (car b))
50.                (vlax-put (cadr a) 'value (cadr b))
51.         )
52.       )
53.     )
54.   )
55.   (princ))

[ronjonp]

Not a lot of time to modify this, but this might work:

Code - Auto/Visual Lisp: [Select]

1. (defun c:foo (/ a b bp c l mp p p1 p2 s s2 x x1 x2 y y1 y2 _x _y)
2.   ;; RJP - 11.15.2017
3.   (if (and (setq p1 (getpoint "\nSpecify first corner: "))
4.            (setq p2 (getcorner p1 "\nSpecify opposite corner:"))
5.            (setq l (list p1 p2))
6.            (setq l (list (apply 'mapcar (cons 'min l)) (apply 'mapcar (cons 'max l))))
7.            (setq s (ssget "_C" p1 p2 '((0 . "insert") (2 . "`*U*,SL-WIRE-FLAG"))))
8.            (setq s2 (ssget "_C" p1 p2 '((0 . "line"))))
9.            (setq p
10.                   (mapcar
11.                     '(lambda (x)
12.                        (if (setq p1 (vl-remove-if-not
13.                                       '(lambda (c) (wcmatch (strcase (vla-get-propertyname c)) "POSITION*"))
14.                                       (vlax-invoke x 'getdynamicblockproperties)
15.                                     )
16.                            )
17.                          (list (vl-sort p1
18.                                         '(lambda (a b) (< (vla-get-propertyname a) (vla-get-propertyname b)))
19.                                )
20.                                (vlax-get x 'insertionpoint)
21.                          )
22.                        )
23.                      )
24.                     (vl-remove-if-not
25.                       '(lambda (d) (vlax-write-enabled-p d))
26.                       (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
27.                     )
28.                   )
29.            )
30.            (setq bp (getpoint "\nSpecify base point: "))
31.            (setq mp (getpoint bp "\nSpecify second point: "))
32.       )
33.     (progn (foreach x (vl-remove 'nil p)
34.              (mapcar 'set '(x1 y1 x2 y2) (mapcar '(lambda (y) (vlax-get y 'value)) (setq c (car x))))
35.              (setq _x (car (cadr x)))
36.              (setq _y (cadr (cadr x)))
37.              (if (setq a (cond ((and (<= (car (mapcar 'car l)) (+ _x x1) (cadr (mapcar 'car l)))
38.                                      (<= (car (mapcar 'cadr l)) (+ _y y1) (cadr (mapcar 'cadr l)))
39.                                 )
40.                                 (list (car c) (cadr c) (list x1 y1))
41.                                )
42.                                ((and (<= (car (mapcar 'car l)) (+ _x x2) (cadr (mapcar 'car l)))
43.                                      (<= (car (mapcar 'cadr l)) (+ _y y2) (cadr (mapcar 'cadr l)))
44.                                 )
45.                                 (list (caddr c) (cadddr c) (list x2 y2))
46.                                )
47.                          )
48.                  )
49.                (progn (setq b (polar (last a) (angle bp mp) (distance bp mp)))
50.                       (vlax-put (car a) 'value (car b))
51.                       (vlax-put (cadr a) 'value (cadr b))
52.                )
53.              )
54.            )
55.            ;; Move lines in selection set
56.            (and s2 (command "_.move" s2 "" bp mp))
57.     )
58.   )
59.   (princ)
60. )

[Coder]

I am not doing great with Autolisp yet but maybe you need to turn off osmode before command move.   

[BIGAL]

Would it be easier to use Group linking the block and the line, do the move then Ungroup

[polhub]

Thanks RonJonP! Works great!

I see you just added a separate selection set, I was trying to merge it with the first but had no luck. I do have a question, it seems that the identified block SL-Wire-Flag is not the only block selected it selects other dynamic blocks as well. Is that because of the below statement? I only ask because I believe I have several blocks with a move position in them (which I can easily change)

(lambda (c) (wcmatch (strcase (vla-get-propertyname c)) "POSITION*"))

Thanks you for your help (the Swamp really needs a thumbs up emogee).

[ronjonp]

Thanks RonJonP! Works great!

I see you just added a separate selection set, I was trying to merge it with the first but had no luck. I do have a question, it seems that the identified block SL-Wire-Flag is not the only block selected it selects other dynamic blocks as well. Is that because of the below statement? I only ask because I believe I have several blocks with a move position in them (which I can easily change)

(lambda (c) (wcmatch (strcase (vla-get-propertyname c)) "POSITION*"))

Thanks you for your help (the Swamp really needs a thumbs up emogee).

Glad it worked for you . If you'd like to only filter out the "SL-WIRE-FLAG" block replace this:

Code - Auto/Visual Lisp: [Select]

1. (vl-remove-if-not
2.   '(lambda (d) (vlax-write-enabled-p d))
3.   (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
4. )

with this:

Code - Auto/Visual Lisp: [Select]

1. (vl-remove-if-not
2.   '(lambda (d)
3.      (or (eq "SL-WIRE-FLAG" (strcase (vla-get-effectivename d))) (vlax-write-enabled-p d))
4.    )
5.   (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
6. )