Author Topic: Select Objects Within Closed Polyline  (Read 2921 times)

0 Members and 1 Guest are viewing this topic.

mailmaverick

  • Bull Frog
  • Posts: 475
Select Objects Within Closed Polyline
« on: March 07, 2018, 11:21:34 PM »
Hi,

I have made a routine for Selecting Objects within a Closed Polyline but it is not working. I'm not able to locate the error. Please help.

Code: [Select]
(defun c:SelectObjectsWithinPoly ()
  (vl-load-com)
  (defun getlayerlist (/ ADOC LAYERLIST lyr)
    (setq LayerList nil)
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    (vlax-for lyr (vla-get-layers adoc) (setq LayerList (cons (vla-get-name lyr) LayerList)))
    LayerList
  )
  (defun getcoords (entpl / r ll)
    (setq ll (vlax-safearray->list
       (vlax-variant-value (vlax-get-property (vlax-ename->vla-object entpl) "Coordinates"))
     )
    )
    (setq r nil)
    (cond ((equal (rem (length ll) 2) 0)
   (repeat (/ (length ll) 2)
     (setq r  (cons (list (car ll) (cadr ll)) r)
   ll (cddr ll)
     )
   )
   (setq r (reverse r))
  )
  ((equal (rem (length ll) 3) 0)
   (repeat (/ (length ll) 3)
     (setq r  (cons (list (car ll) (cadr ll) (caddr ll)) r)
   ll (cdddr ll)
     )
   )
   (setq r (reverse r))
  )
    )
    r
  )
;;;
  (setq opt1 (list "Polylines (Closed)" "Polylines (Open)" "Lines" "Text" "Mtext" "Blocks" "Circles" "Dimensions")
  )
  (setq opt2 (getlayerlist))
  (if (and (progn (prompt "\nSelect any 1 Closed Polyline : ") T)
   (setq cpolyss (ssget "_+.:E:S" (list (cons 0 "*Polyline") (cons 70 1))))
   (setq cpoly (ssname cpolyss 0))
   (setq cpolycoords (getcoords cpoly))
   (setq opt1sel (LM:ListBox "Select Objects to Select : " opt1 1))
   (setq opt2sel (LM:ListBox "Select Layers to Filter : " opt2 1))
   (setq sellist (append (if (member "Polylines (Closed)" opt1sel)
   (progn (list (cons -4 "<OR")
(cons -4 "<AND")
(cons 0 "*polyline")
(cons 70 1)
(cons -4 "AND>")
(cons -4 "OR>")
  )
   )
)
(if (member "Polylines (Open)" opt1sel)
   (progn (list (cons -4 "<OR")
(cons -4 "<AND")
(cons 0 "*polyline")
(cons -4 "<OR")
(cons 70 0)
(cons 70 128)
(cons -4 "OR>")
(cons -4 "AND>")
(cons -4 "OR>")
  )
   )
)
(if (member "Lines" opt1sel)
   (progn (list (cons -4 "<OR") (cons 0 "line") (cons -4 "OR>")))
)
(if (member "Text" opt1sel)
   (progn (list (cons -4 "<OR") (cons 0 "TEXT") (cons -4 "OR>")))
)
(if (member "Mtext" opt1sel)
   (progn (list (cons -4 "<OR") (cons 0 "MTEXT") (cons -4 "OR>")))
)
(if (member "Blocks" opt1sel)
   (progn (list (cons -4 "<OR") (cons 0 "INSERT") (cons -4 "OR>")))
)
(if (member "Circles" opt1sel)
   (progn (list (cons -4 "<OR") (cons 0 "Circle") (cons -4 "OR>")))
)
(if (member "Dimensions" opt1sel)
   (progn (list (cons -4 "<OR") (cons 0 "Dimension") (cons -4 "OR>")))
)
(list (cons -4 "<AND") (cons -4 "<OR"))
(mapcar '(lambda (lyr) (cons 8 lyr)) opt2sel)
(list (cons -4 "OR>") (cons -4 "AND>"))
)
   )
   (setq ss (ssget "_CP" cpolycoords sellist))
      )
    (progn (sssetfirst nil ss) (princ (strcat "\n" (itoa (sslength ss)) " objects selected.")))
  )
  (Princ)
)


gile

  • Water Moccasin
  • Posts: 2411
  • Marseille, France
Re: Select Objects Within Closed Polyline
« Reply #1 on: March 08, 2018, 02:58:25 AM »
Hi,

Maybe you can get some inspiration from this one

Code - Auto/Visual Lisp: [Select]
  1. ;;; SelByObj -Gilles Chanteau- 06/10/06
  2. ;;; Crée un jeu de sélection avec tous les objets contenus ou
  3. ;;; capturés, dans la vue courante, par l'objet sélectionné
  4. ;;; (cercle, ellipse, polyligne fermée).
  5. ;;; Arguments :
  6. ;;; - un nom d'entité (ename)
  7. ;;; - un mode de sélection (Cp ou Wp)
  8. ;;; - un filtre de sélection ou nil
  9. ;;;
  10. ;;; modifié le 19/07/07 : fonctionne avec les objets hors fenêtre
  11.  
  12. ;;; Creates a selection set by crossing or window polygon
  13. ;;; using a curve entity (circle, ellipse or closed polyline)
  14. ;;; Arguments :
  15. ;;; - ename of the entity use for selection
  16. ;;; - selection mode (CP or WP)
  17. ;;; - a selection filter or nil
  18.  
  19. (defun SelByObj (ent opt fltr / obj dist n lst prec dist p_lst ss)
  20.   (if (= (type ent) 'ENAME)
  21.     (setq obj (vlax-ename->vla-object ent))
  22.     (setq obj ent
  23.           ent (vlax-vla-object->ename ent)
  24.     )
  25.   )
  26.   (cond
  27.     ((member (vla-get-ObjectName obj) '("AcDbCircle" "AcDbEllipse"))
  28.                      obj
  29.                      (vlax-curve-getEndParam obj)
  30.                    )
  31.                    50
  32.                 )
  33.            n    0
  34.      )
  35.      (repeat 50
  36.        (setq
  37.          lst
  38.           (cons
  39.             (trans
  40.               (vlax-curve-getPointAtDist obj (* dist (setq n (1+ n))))
  41.               0
  42.               1
  43.             )
  44.             lst
  45.           )
  46.        )
  47.      )
  48.     )
  49.     ((and (= (vla-get-ObjectName obj) "AcDbPolyline")
  50.           (= (vla-get-Closed obj) :vlax-true)
  51.           )
  52.      (setq p_lst (vl-remove-if-not
  53.                    '(lambda (x)
  54.                       (or (= (car x) 10)
  55.                           (= (car x) 42)
  56.                       )
  57.                     )
  58.                    (entget ent)
  59.                  )
  60.      )
  61.      (while p_lst
  62.        (setq
  63.          lst
  64.           (cons
  65.             (trans (append (cdr (assoc 10 p_lst))
  66.                                  (list (cdr (assoc 38 (entget ent))))
  67.                          )
  68.                          ent
  69.                          1
  70.             )
  71.             lst
  72.           )
  73.        )
  74.        (if (/= 0 (cdadr p_lst))
  75.          (progn
  76.            (setq prec (1+ (fix (* 25 (sqrt (abs (cdadr p_lst))))))
  77.                  dist (/ (- (if (cdaddr p_lst)
  78.                               (vlax-curve-getDistAtPoint
  79.                                 obj
  80.                                 (trans (cdaddr p_lst) ent 0)
  81.                               )
  82.                               (vlax-curve-getDistAtParam
  83.                                 obj
  84.                                 (vlax-curve-getEndParam obj)
  85.                               )
  86.                             )
  87.                             (vlax-curve-getDistAtPoint
  88.                               obj
  89.                               (trans (cdar p_lst) ent 0)
  90.                             )
  91.                          )
  92.                          prec
  93.                       )
  94.                  n    0
  95.            )
  96.            (repeat (1- prec)
  97.              (setq
  98.                lst (cons
  99.                      (trans
  100.                          (vlax-curve-getPointAtDist
  101.                            obj
  102.                            (+ (vlax-curve-getDistAtPoint
  103.                                 obj
  104.                                 (trans (cdar p_lst) ent 0)
  105.                               )
  106.                               (* dist (setq n (1+ n)))
  107.                            )
  108.                          )
  109.                          0
  110.                          1
  111.                        )
  112.                      lst
  113.                    )
  114.              )
  115.            )
  116.          )
  117.        )
  118.        (setq p_lst (cddr p_lst))
  119.      )
  120.     )
  121.   )
  122.   (cond
  123.     (lst
  124.      (setq ss (ssget (strcat "_" opt) lst fltr))
  125.      ss
  126.     )
  127.   )
  128. )
« Last Edit: March 08, 2018, 05:26:43 AM by gile »
Speaking English as a French Frog

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Select Objects Within Closed Polyline
« Reply #2 on: March 08, 2018, 04:02:41 AM »
@mailmaverick:
Two things stand out in your code:
1.
When parsing the coordinates as returned by the vla-get-coordinates function you should check the object type (via the objectname property) to determine if the list has the (X Y X Y X Y ...) format, or the (X Y Z X Y Z X Y Z ...) format. Relying on the length of the list will lead to incorrect results.
2.
The coordinates from the (2D) polyline have to be translated from the OCS to the current UCS. Note that a (2D) polyline has an elevation (in the OCS).
« Last Edit: March 08, 2018, 04:11:06 AM by roy_043 »

BIGAL

  • Swamp Rat
  • Posts: 1136
  • 40 + years of using Autocad
Re: Select Objects Within Closed Polyline
« Reply #3 on: March 08, 2018, 04:50:53 AM »
Just happen to have one in the back pocket like Roy_043 does not check for 3d pline.

Code: [Select]

; Text in polygons
; By Alan H may 2013
(vl-load-com)
(defun getcoords (ent)
  (vlax-safearray->list
    (vlax-variant-value
      (vlax-get-property
    (vlax-ename->vla-object ent)
    "Coordinates"
      )
    )
  )
)
 
(defun co-ords2xy ()
; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z
(setq numb (/ (length co-ords) 2))
(setq I 0)
(repeat numb
(setq xy (list (nth I co-ords)(nth (+ I 1) co-ords) ))
(setq coordsxy (cons xy coordsxy))
(setq I (+ I 2))
) ; end repeat
) ; end defun


; program starts here
; choose output file change acdatemp to what you want
(setq fname (strcat "c:/alan/" (getstring "\nEnter file name ")))
(setq fout (open fname "w"))
(setq plobjs (ssget (list (cons 0 "lwpolyline"))))
(setq numb1 (sslength plobjs))
(setq x numb1)
(repeat numb1
(setq obj (ssname plobjs (setq x (- x 1))))
(setq co-ords (getcoords obj))
(co-ords2xy)
; write pline co-ords here
(setq numb3 (length co-ords))
(setq z numb3)
(setq ansco-ords "")
(repeat numb3
(setq ansco-ords (strcat ansco-ords (rtos (nth (setq z (- z 1)) co-ords) 2 3 ) " " ))
)
(setq ans (strcat "Pline " ansco-ords))
(write-line ans fout)
(setq ansco-ords "")
(setq ss (ssget "WP" coordsxy (list (cons 0 "Text,Mtext")))) ; selection set of text within polygon
(if (= ss nil)
(princ "\nnothing inside")
(progn
(setq coordsxy nil) ; reset for next time
(setq numb2 (sslength ss))
(setq y numb2)
(repeat numb2
(setq anstext (vlax-get-property (vlax-ename->vla-object (ssname ss (setq y (- y 1)))) "Textstring"))
(princ anstext) ; change to write text to file
(write-line (strcat "text " anstext) fout)
(princ "\n")
) ; end repeat2
(setq ss nil) ; reset for next poly
)
)
) ; end repeat1
(close fout)
(princ)
A man who never made a mistake never made anything

alanjt

  • Needs a day job
  • Posts: 5349
  • Standby for witty remark...
Re: Select Objects Within Closed Polyline
« Reply #4 on: March 08, 2018, 08:38:54 AM »
Another...

Code: [Select]
(defun c:SelW (/ _pac add ss i e temp it o a b pts tempC i3 ec)
  ;; Select Within/Crossing Curve
  ;; Alan J. Thompson, 03.31.11 / 05.11.11

  (vl-load-com)

  (defun _pac (e / l v d lst)
    (setq d (- (setq v (/ (setq l (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))) 100.))))
    (while (< (setq d (+ d v)) l)
      (setq lst (cons (trans (vlax-curve-getPointAtDist e d) 0 1) lst))
    )
  )

  (initget 0 "Crossing Within")
  (setq *SWCC:Opt*
         (cond ((getkword (strcat "\nSpecify selection method witin curve [Crossing/Within] <"
                                  (cond (*SWCC:Opt*)
                                        ((setq *SWCC:Opt* "Crossing"))
                                  )
                                  ">: "
                          )
                )
               )
               (*SWCC:Opt*)
         )
  )

  (princ "\nSelect closed curves to select object(s) within: ")
  (if (setq add (ssadd)
            ss  (ssget '((-4 . "<OR")
                         (0 . "CIRCLE,ELLIPSE")
                         (-4 . "<AND")
                         (0 . "*POLYLINE")
                         (-4 . "&=")
                         (70 . 1)
                         (-4 . "AND>")
                         (-4 . "OR>")
                        )
                )
      )
    (progn (repeat (setq i (sslength ss))
             (if (setq temp (ssget "_WP" (_pac (setq e (ssname ss (setq i (1- i)))))))
               (repeat (setq i2 (sslength temp)) (ssadd (ssname temp (setq i2 (1- i2))) add))
             )

             (if (eq *SWCC:Opt* "Crossing")
               (progn (vla-getboundingbox (setq o (vlax-ename->vla-object e)) 'a 'b)
                      (setq pts (mapcar 'vlax-safearray->list (list a b)))
                      (if (setq tempC (ssget "_C"
                                             (list (caar pts) (cadar pts) 0.)
                                             (list (caadr pts) (cadadr pts) 0.)
                                      )
                          )
                        (repeat (setq i3 (sslength tempC))
                          (if (vlax-invoke
                                o
                                'Intersectwith
                                (vlax-ename->vla-object (setq ec (ssname tempC (setq i3 (1- i3)))))
                                acExtendNone
                              )
                            (ssadd ec add)
                          )
                        )
                      )
               )
             )
           )
           (sssetfirst nil add)
           (ssget "_I")
    )
  )
  (princ)
)
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

Romero

  • Newt
  • Posts: 24
Re: Select Objects Within Closed Polyline
« Reply #5 on: March 10, 2018, 02:04:13 AM »
There are 2 routines:
SSP The first, select all objects that are completely inside.
SSP2 The second one selects everything inside the object plus objects that it touches.


It works with ellipses circles and polylines.

Code: [Select]
;======SELBYOBJ: FUNCION INTERNA PARA OCUPAR EN 2 RUTINAS POSTERIORES================

(defun SelByObj  (ent opt fltr / obj dist n lst prec dist p_lst ss)
  (vl-load-com)
  (if (= (type ent) 'ENAME)
    (setq obj (vlax-ename->vla-object ent))
    (setq obj ent
  ent (vlax-vla-object->ename ent)
    )
  )
  (cond
    ((member (vla-get-ObjectName obj) '("AcDbCircle" "AcDbEllipse"))
     (setq dist (/ (vlax-curve-getDistAtParam
     obj
     (vlax-curve-getEndParam obj)
   )
   50
)
   n 0
     )
     (repeat 50
       (setq
lst
  (cons
    (trans
      (vlax-curve-getPointAtDist obj (* dist (setq n (1+ n))))
      0
      1
    )
    lst
  )
       )
     )
    )
    ((and (= (vla-get-ObjectName obj) "AcDbPolyline")
  (= (vla-get-Closed obj) :vlax-true)
  )
     (setq p_lst (vl-remove-if-not
   '(lambda (x)
      (or (= (car x) 10)
  (= (car x) 42)
      )
    )
   (entget ent)
)
     )
     (while p_lst
       (setq
lst
  (cons
    (trans (append (cdr (assoc 10 p_lst))
(list (cdr (assoc 38 (entget ent))))
)
ent
1
    )
    lst
  )
       )
       (if (/= 0 (cdadr p_lst))
(progn
   (setq prec (1+ (fix (* 25 (sqrt (abs (cdadr p_lst))))))
dist (/ (- (if (cdaddr p_lst)
      (vlax-curve-getDistAtPoint
obj
(trans (cdaddr p_lst) ent 0)
      )
      (vlax-curve-getDistAtParam
obj
(vlax-curve-getEndParam obj)
      )
    )
    (vlax-curve-getDistAtPoint
      obj
      (trans (cdar p_lst) ent 0)
    )
)
prec
      )
n    0
   )
   (repeat (1- prec)
     (setq
       lst (cons
     (trans
(vlax-curve-getPointAtDist
   obj
   (+ (vlax-curve-getDistAtPoint
obj
(trans (cdar p_lst) ent 0)
      )
      (* dist (setq n (1+ n)))
   )
)
0
1
       )
     lst
   )
     )
   )
)
       )
       (setq p_lst (cddr p_lst))
     )
    )
  )
  (cond
    (lst
     (vla-ZoomExtents (vlax-get-acad-object))
     (setq ss (ssget (strcat "_" opt) lst fltr))
     (vla-ZoomPrevious (vlax-get-acad-object))
     ss
    )
  )
)

;==========SSP ----> Selecciona todo, completamente  dentro de: Pline, Elipse ó Circulo.====================


(defun c:SSP (/ ss opt)
  (and
    (or
      (and
(setq ss (cadr (ssgetfirst)))
(= 1 (sslength ss))
      )
      (and
(sssetfirst nil nil)
(setq ss (ssget "_:S:E"
(list
  '(-4 . "<OR")
  '(0 . "CIRCLE")
  '(-4 . "<AND")
  '(0 . "ELLIPSE")
  '(41 . 0.0)
  (cons 42 (* 2 pi))
  '(-4 . "AND>")
  '(-4 . "<AND")
  '(0 . "LWPOLYLINE")
  '(-4 . "&")
  '(70 . 1)
  '(-4 . "AND>")
  '(-4 . "OR>")
)
)
)
      )
    )
    (sssetfirst
      nil
      (SelByObj (ssname ss 0) "Wp" nil)
    )
  )
  (princ)
)

;==========SSP2 ----> Selecciona todo dentro, más lo que toca la: Pline, Elipse ó Circulo.====================

(defun c:SSP2 (/ ss opt)
  (and
    (or
      (and
(setq ss (cadr (ssgetfirst)))
(= 1 (sslength ss))
      )
      (and
(sssetfirst nil nil)
(setq ss (ssget "_:S:E"
(list
  '(-4 . "<OR")
  '(0 . "CIRCLE")
  '(-4 . "<AND")
  '(0 . "ELLIPSE")
  '(41 . 0.0)
  (cons 42 (* 2 pi))
  '(-4 . "AND>")
  '(-4 . "<AND")
  '(0 . "LWPOLYLINE")
  '(-4 . "&")
  '(70 . 1)
  '(-4 . "AND>")
  '(-4 . "OR>")
)
)
)
      )
    )
    (sssetfirst
      nil
      (ssdel (ssname ss 0) (SelByObj (ssname ss 0) "Cp" nil))
    )
  )
  (princ)
)

dopefish

  • Mosquito
  • Posts: 1
Re: Select Objects Within Closed Polyline
« Reply #6 on: December 02, 2022, 12:11:51 PM »
The code in the last post works great. I have a small ask if anyone would be so kind. Is there a way to modify the code to allow for the selection of multiple closed polylines and end up with one large selection of everything?

BIGAL

  • Swamp Rat
  • Posts: 1136
  • 40 + years of using Autocad
Re: Select Objects Within Closed Polyline
« Reply #7 on: December 02, 2022, 06:29:29 PM »
I am no expert on using -4's but is '(-4 . "&") needed ? Not tested.
A man who never made a mistake never made anything