Selects everything that touches pre-selected objects

[macros55]

Hello friends,

 

Selects everything that touches pre-selected objects

I have such a lisp, it works even if the selected objects is few,

but when the selected objects are to much it wastes a lot of time and sometimes gives an error.

 

How can we make this better?

You can find the Lisp and dwg in the attachment. test.lsp testss.dwg

 

 

 

 

 

test.Lsp

test ss.dwg

Edited June 15 by macros55

[BIGAL]

Not sure what your exactly after, is it getting intersection points of objects touching the red pline ? If so use a ssget "F" to get objects. Note it also selects the pline object.

 

(defun c:test ( / plent co-ord ss ss1 ss2 x y)
(prompt "Select plines")
(setq ss (ssget '((0 . "LWPOLYLINE")(8 . "WALL"))))
(setq ss2 (ssadd))
(repeat (setq x (sslength ss))
  (setq plent (ssname ss (setq x (1- x))))
  (if plent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget plent)))))
  (setq co-ord (cons (last co-ord) co-ord))
  (setq ss1 (ssget "F" co-ord (list (cons 0 "LINE,LWPOLYLINE,ARC,CIRCLE,POINT,TEXT,MTEXT,insert"))))
  (repeat (setq Y (sslength ss1))
   (setq ss2 (ssadd (ssname ss1 (setq y (1- y))) ss2))
  )
)
(princ (sslength ss2))
(princ)
)
(c:test)

pl

Please explain more

Edited June 17 by BIGAL

[macros55]

Good day Mr. Bigal,

 

Please see attached foto and video

 

1.Select object or objects 
2.Command test
3. Touched objects are automatically selected

 

When the selected object(Red Pline) is few(1 or 2 pcs.), it works normally,

but when the selected objects (Red Pline) are too much(100pcs.),

Process takes too much time or error.

 

 

Edited June 16 by macros55

[BIGAL]

I updated code above and got 1189 objects. Instantly.

 

OK the dumb question why do it ? What is end goal. 

Edited June 17 by BIGAL

[srikanth_0126]

Hi BIGAL,

its possible select the text layer(it contains multiple mtext) first, select the overlapping polylines and move them to different?

[exceed]

just add this line

(sssetfirst nil ss2)

 

below of this line

(princ (sslength ss2))

 

you will get this

 

 

 

and then 

you want to select multileader too,

edit this line

(setq ss1 (ssget "F" co-ord (list (cons 0 "LINE,LWPOLYLINE,ARC,CIRCLE,POINT,TEXT,MTEXT,insert"))))

(setq ss1 (ssget "F" co-ord (list (cons 0 "LINE,LWPOLYLINE,ARC,CIRCLE,POINT,TEXT,MTEXT,INSERT,MULTILEADER"))))

 

Edited June 17 by exceed

[macros55]

Mr. Exceed Good day,

 

The first selected objects are: "not only LWPOLYLINE, need (ALL objects) Is it possible this? 
(setq ss (ssget '((0 . "*****here ALL objects****"))))
(setq ss1 (ssget "F" co-ord (list (cons 0 "*****here ALL objects****"))))

 

Also is it possible no need the layer? without layer. (8 . "WALL"))))

 

[exceed]

if you need all object

you cad do it with just delete '((0 . ~~~))

 

(setq ss (ssget '((0 . "LWPOLYLINE")(8 . "WALL"))))

(setq ss (ssget '((8 . "WALL"))))

or you want all of layer

(setq ss (ssget))

 

and also ss1

(setq ss1 (ssget "F" co-ord (list (cons 0 "LINE,LWPOLYLINE,ARC,CIRCLE,POINT,TEXT,MTEXT,insert"))))

(setq ss1 (ssget "F" co-ord))

 

 

 

If you want to exclude wall layer from the selected objects

(setq ss1 (ssget "F" co-ord '((-4 . "<NOT") (8 . "WALL") (-4 . "NOT>"))))

 

[macros55]

Mr. Exceed Good day,

 

for all of layer and all of objects

 

I tried but didn't happen.

 

Cloud you please check?

 

I have attached the dwg file.

 

 

(defun c:test2 ( / plent co-ord ss ss1 ss2 x y)
(prompt "Select plines")
(setq ss (ssget))
(setq ss2 (ssadd))
(repeat (setq x (sslength ss))
  (setq plent (ssname ss (setq x (1- x))))
  (if plent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget plent)))))
  (setq co-ord (cons (last co-ord) co-ord))
  (setq ss1 (ssget "F" co-ord))
  (repeat (setq Y (sslength ss1))
   (setq ss2 (ssadd (ssname ss1 (setq y (1- y))) ss2))
  )
)
(princ (sslength ss2))
(sssetfirst nil ss2)
(princ)
)
(c:test2)

 

test ss2.dwg TEST2.Lsp

[srikanth_0126]

Tried removing '((0.~~~~)).

But not working.

Could you please update the code

[exceed]

 

because, all objects were selected in ssget by deleting that

but in later process (collecting dxf 10) is only works for polylines.

 

The process of obtaining borders for all objects is not as easy as you might think.

 

Depending on your purpose, if you only want the accuracy of the rectangle containing the shape,

using vla-getboundingbox to get the lowest and lowest points,

change the last ssget to "c" and use it.

 

If you need exactly the border,

you can use Lee Mac's Outline Object https://www.lee-mac.com/outlineobjects.html

to obtain the border polyline and then use that polyline.

In this process, you must also consider how to handle inside closed lines, like donuts inside the block

and how to handle cases such as lines and arcs that do not create an area.

 

 

I don't know what the purpose of this is,

but if there are a lot of target objects and the type of border cannot even be specified,

It is better to separate the layers. Or, it is more appropriate to select using QSELECT.

 

[srikanth_0126]

i have small polylines and DW text on it. so i want select those polylines and change those pl into another layer. 

all polylines are in same layer so, i have this text to select the overlapping objects.

[macros55]

@srikanth_0126 Mr, if you need a different lisp, please open a new topic.

My topic is to select other objects that touch the selected objects. 

[srikanth_0126]

Hi @macros55,

its a same thing but, i select text objects to select touching polylines.

[macros55]

@Exceed Mr, I need to select other objects that touch the selected objects. But not only selected Pline, sometimes " 3dpolyline, line, block, circle text, mtext, etc."

[Tsuky]

Any start with this?
This mainly deals with curvilinear entities

(defun def_bulg_pl (ls lb flag_closed / ls lb rad a l_new)
  (if (not (zerop flag_closed)) (setq ls (append ls (list (car ls)))))
  (while (cadr ls)
    (if (zerop (car lb))
      (setq l_new (append l_new (list (car ls))))
      (progn
        (setq
          rad (/ (distance (car ls) (cadr ls)) (sin (* 2.0 (atan (abs (car lb))))) 2.0)
          a (- (/ pi 2.0) (- pi (* 2.0 (atan (abs (car lb))))))
        )
        (if (< a 0.0) (setq a (- (* 2.0 pi) a)))
        (if (or (and (< (car lb) 0.0) (> (car lb) -1.0)) (> (car lb) 1.0))
          (setq l_new (append l_new (reverse (cdr (reverse (bulge_pts (polar (car ls) (- (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb)))))))
          (setq l_new (append l_new (reverse (cdr (reverse (bulge_pts (polar (car ls) (+ (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb)))))))
        )
      )
    )
    (setq ls (cdr ls) lb (cdr lb))
  )
  (append l_new (list (car ls)))
)
(defun bulge_pts (pt_cen pt_begin pt_end rad sens / inc ang nm p1 p2 lst)
  (setq
    inc (angle pt_cen (if (< sens 0.0) pt_end pt_begin))
    ang (+ (* 2.0 pi) (angle pt_cen (if (< sens 0.0) pt_begin pt_end)))
    nm (fix (/ (rem (- ang inc) (* 2.0 pi)) (/ (* pi 2.0) 36.0)))
  )
  (repeat nm
    (setq
      p1 (polar pt_cen inc rad)
      inc (+ inc (/ (* pi 2.0) 36.0))
      lst (append lst (list p1))
    )
  )
  (setq
    p2 (polar pt_cen ang rad)
    lst (append lst (list p2))
  )
  (if (< sens 0.0) (reverse lst) lst)
)
(defun min-max (l / l2)
  (if (> (length l) 255)
    (repeat 255 (setq l2 (cons (car l) l2) l (cdr l)))
    (setq l2 l l nil)
  )
  (setq
    minpt (list (eval (cons min (mapcar 'car l2))) (eval (cons min (mapcar 'cadr l2))))
    maxpt (list (eval (cons max (mapcar 'car l2))) (eval (cons max (mapcar 'cadr l2))))
  )
  (if l (min-max (append (list minpt maxpt) l)))
  (list minpt maxpt)
)
(defun c:sel_by_obj-touch ( / ent dxf_ent typent last_ent master closed lst l_bulg e_next key osmd vmin vmax minpt maxpt l_limit zt ss)
  (setvar "CMDECHO" 0)
  (while (null (setq ent (nentsel "\nChoice of entity: "))))
  (setq typent (cdr (assoc 0 (setq dxf_ent (entget (car ent))))))
  (if (eq (type (car (last ent))) 'ENAME)
    (progn
      (setq
        last_ent (entmake dxf_ent)
        master (entget (car (last ent)))
      )
      (command "_.move" (entlast) "" "_none" (trans '(0 0 0) 0 1)"_none" (trans (cdr (assoc 10 master)) 0 1))
      (command "_.rotate" (entlast) "" "_none" (trans (cdr (assoc 10 master)) 0 1) (cdr (assoc 50 master)))
      (command "_.scale" (entlast) "" "_none" (trans (cdr (assoc 10 master)) 0 1) (cdr (assoc 41 master)))
      (setq dxf_ent (entget (entlast)) ent (list (cdar dxf_ent)))
    )
  )
  (cond
    ((eq typent "LWPOLYLINE")
      (setq
        closed (boole 1 (cdr (assoc 70 dxf_ent)) 1)
        lst (mapcar '(lambda (x) (trans x (car ent) 1)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)))
        l_bulg (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 42)) dxf_ent))
        lst (def_bulg_pl lst l_bulg closed)
      )
    )
    ((eq typent "SPLINE")
      (setq
        closed (boole 1 (cdr (assoc 70 dxf_ent)) 1)
        lst (mapcar '(lambda (x) (trans x (car ent) 1)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 11)) dxf_ent)))
      )
    )
    ((eq typent "POLYLINE")
      (setq
        closed (boole 1 (cdr (assoc 70 dxf_ent)) 1)
        e_next (entnext (car ent))
      )
      (while (= "VERTEX" (cdr (assoc 0 (setq dxf_next (entget e_next)))))
        (if (zerop (boole 1 223 (cdr (assoc 70 dxf_next))))
          (setq
            lst (cons (trans (cdr (assoc 10 dxf_next)) (car ent) 1) lst)
            l_bulg (cons (cdr (assoc 42 dxf_next)) l_bulg)
          )
        )
        (setq e_next (entnext e_next))
      )
      (setq
        lst (reverse lst)
        l_bulg (reverse l_bulg)
        lst (def_bulg_pl lst l_bulg closed)
      )
    )
    ((eq typent "LINE")
      (setq
        lst (list (trans (cdr (assoc 10 dxf_ent)) 0 1) (trans (cdr (assoc 11 dxf_ent)) 0 1))
        closed 0
      )
    )
    ((eq typent "CIRCLE")
      (setq
        lst
          (bulge_pts
            (trans (cdr (assoc 10 dxf_ent)) (car ent) 1)
            (trans (polar (cdr (assoc 10 dxf_ent)) 0.0 (cdr (assoc 40 dxf_ent))) (car ent) 1)
            (trans (polar (cdr (assoc 10 dxf_ent)) (- (* 2.0 pi) (/ (* pi 2.0) 36.0)) (cdr (assoc 40 dxf_ent))) (car ent) 1)
            (cdr (assoc 40 dxf_ent))
            1
          )
        lst (append lst (list (car lst)))
        closed 1
      )
    )
    ((eq typent "ARC")
      (setq
        lst
          (bulge_pts
            (trans (cdr (assoc 10 dxf_ent)) (car ent) 1)
            (trans (polar (cdr (assoc 10 dxf_ent)) (cdr (assoc 50 dxf_ent)) (cdr (assoc 40 dxf_ent))) (car ent) 1)
            (trans (polar (cdr (assoc 10 dxf_ent)) (cdr (assoc 51 dxf_ent)) (cdr (assoc 40 dxf_ent))) (car ent) 1)
            (cdr (assoc 40 dxf_ent))
            1
          )
        closed 0
      )
    )
    (T (princ "\nIs not a Line, Arc, Circle or Polyline!"))
  )
  (cond
    (lst
      (setq osmd (getvar "osmode"))
      (setvar "osmode" 0)
      (setq
        vmin (mapcar '- (getvar "viewctr") (list (/ (* (car (getvar "screensize")) (* 0.5 (getvar "viewsize"))) (cadr (getvar "screensize"))) (* 0.5 (getvar "viewsize")) 0.0))
        vmax (mapcar '+ (getvar "viewctr") (list (/ (* (car (getvar "screensize")) (* 0.5 (getvar "viewsize"))) (cadr (getvar "screensize"))) (* 0.5 (getvar "viewsize")) 0.0))
        l_limit (min-max lst)
        zt (or (< (caar l_limit) (car vmin)) (< (cadar l_limit) (cadr vmin)) (> (caadr l_limit) (car vmax)) (> (cadadr l_limit) (cadr vmax)))
      )
      (if zt (command "_.zoom" "_window" (car l_limit) (cadr l_limit)))
      (if (zerop (getvar "pickfirst")) (setvar "pickfirst" 1))
      (if last_ent
        (progn
          (entdel (entlast))
          (setq ss (ssdel (cdar master) (ssget "_F" lst)))
        )
        (setq ss (ssdel (car ent) (ssget "_F" lst)))
      )
      (sssetfirst nil ss)
      (setvar "osmode" osmd)
    )
    (T (entdel (entlast)))
  )
  (setvar "CMDECHO" 1)
  (prin1)
)

 

Edited June 21 by Tsuky

[macros55]

Mr Tsuky,  Good day, It's good to see you again. how are you?

I tried some object (circle, line, arc)working ,but other (pline, block, point, text,revcloud, etc.) not working.

I need for all of objects

Please see attached test ss3.dwg file.

test ss3.dwg

[Tsuky]

I fixed my code, please reload it from my previous post.
This works for any curvilinear entity.
It can also work for a block if it is made up of nested curvilinear objects.

On the other hand, for other objects such as texts, it is much more complicated because it would be necessary to take into account the justification of the text, its rotation, possibly the UCS used, or that the text is contained in a block (with again : an insertion point, a rotation, an insertion, a scale) to obtain a selection path (_FENCE) from the function (textbox). So really a headache for transforming coordinates...

[macros55]

Mr. Tsuky, I tried the code , I think it can make selections one by one.

Is it possible to select more than one object at the same time? for example, I need to select all object(not only pline) which are touching my all objects(not only pline) in one time

Edited June 21 by macros55

[Tsuky]

It's doable, but in this case I can no longer use the blocks as a source.
You can use _QSELECT (or SELECTSIMILAR) or nothing at all for manual selection before using the code.

sel_by_obj-touch(bis).lsp