Selection of outer closed polylines

[Anonymous]

Hi,

I am searching for a solution for selecting the outermost polylines (or circles), but not the polylines within. I do not believe QSELECT will work, as the shape of the inner and outer polylines vary very much. I got hundreds of these objects, which I need to select and put in separate layers depending on the occurance of the polyline.

I have attached pictures of an examples of the problem, my thought solution and outcome of this solution.

Hope anyone have a solution for doing this to multible polylines/circles at once.

Kind regards

[imadHabash]

Hi and Welcome to AutoCAD Forum,

This kind of commands need an outsource lisp routine that could help. for many years i used to use this helpful lisp  >> Click << that will help you to select all objects inside a border defined by an existing polyline or circle . i know that you need the items outside polyline but you can use this lisp to isolate the inner items or erase/oops.

hope that help you and good luck ...

[john.vellek]

Hi @Anonymous,

I see that you are visiting as a new member to the AutoCAD forum. Welcome to the Autodesk Community!

This is an interesting problem.  I did a quick query in the Autodesk App Store and found quite a few add ins that are related to Selections.  Perhaps one of these will give you that kind of granularity in your selection set.

Please select the Accept as Solution button if my post solves your issue or answers your question.

[parkr4st]

qselect manually could work

if all the outer objects are polylines which includes closed polygons

measure the largest inner polygon and copy the area from properties

set qselect to object type polyline; properties to area; operator to greater than; and the value to the area of the largest inner polygon

only larger polygons will be selected which should all be the outer polygons

repeat for circles

dave

[Vinayv4v]

Hello,

Try this one which will help you select polylines of same area.

Command : ssarea

Won't work on circles and cannot determine boundaries.

[Anonymous]

Hi,

Thank you for your attempts to help me.

I will take it from the top.

With WPS I am only able to select the inner polylines of one outer polyline. I have many!!! So this does not help me.

In the Autodesk App Store I found an app called TotalBoundary (Pro) which was able to create a perfect outline of the outer polylines. This was put in a separate layer. Fine. But the original outer polylines were still there, so I could not do the next iteration/layer without manually deleting the outer polylines first. This is why I really need a selction routine rather than a deleting or contour creating routine. I also tried the overkill function to delete both the original and new lines, which are overlapping, but this was unsuccesfull. Also tried with all lines exploded, but this only deleted one of the overlapping lines.

QSELECT does not work because many of the outer polylines have smaller areas than the inner polylines.

SSAREA will not work as only few areas are the same.

Looking forward to other suggestions 🙂

Best regards

[pbejse]

---

@Anonymous wrote:

...Looking forward to other suggestions 🙂

Best regards

---

(defun c:demo (/ _inside-p PLC e collection ss i )
      
;;;		pBe Sep 2017			;;;

  (defun  _inside-p ( pt obj / lst Yoray )
    (setq lst
        (vlax-invoke
            (setq Yoray
                (vla-addray
                    (vla-objectidtoobject (vla-get-document obj) (vla-get-ownerid obj))
                    (vlax-3D-point pt)
                    (vlax-3D-point (mapcar '+ pt '(1.0 0.0 0.0)))
                )
            )
            'intersectwith obj acextendnone
        )
    )
    (vla-delete Yoray)
    (= 1 (logand 1 (length lst)))
)
;;;		Kent Cooper		;;;
      
(defun PLC (pl / verts qua vertsum vertavg); = PolyLine Centroid
  (if pl
    (progn ; 'then'
      (setq
        verts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget pl))); list of vertices
        qua (length verts); quantity of vertices
        vertsum (car verts); first one
      ); setq
      (foreach vert (cdr verts) (setq vertsum (mapcar '+ vert vertsum)))
      (setq vertavg (mapcar '/ vertsum (list qua qua))); average of vertex locations
      vertavg
    ); progn
  ); if
); defun      
      
;;; pBe 2017 ;;;

(foreach itm '(("Inside" 2)("Outside" 4))
	(if (not (tblsearch "LAYER" (car itm)))
	  (entmake (list (cons 0 "LAYER")
	                 (cons 100 "AcDbSymbolTableRecord")
	                 (cons 100 "AcDbLayerTableRecord")
	                 (cons 2 (car itm))(cons 62 (cadr itm))
	                 (cons 70 0))))
      )
      
      

  (if	(setq collection nil ss  (ssget "_X" '((-4 . "<OR")  (0 . "CIRCLE")
					 (-4 . "<AND") (0 . "LWPOLYLINE")(70 . 1)
					 (-4 . "AND>")  (-4 . "OR>")(410 . "Model"))))
        
    (progn
          (repeat (setq i (sslength ss))
                (setq e (ssname ss (setq i (1- i))))
                (setq collection (cons (list (plc e) (vlax-ename->vla-object e))  collection)))
          
          (while (setq a (Car collection))
                 (setq b (cdr collection))
                (Vla-put-layer (cadr a)
		 (if (vl-some (function (lambda (o)
	                                         (if (_inside-p (Car a) (cadr o))
                                                     (setq f o))))
	                      b)
                     "Inside" "Outside")
                      )
                (setq collection b))
          )
        )
)

It would be nice if we can filter the targetted LWPOLYLINE & CIRCLE if they are on a unique layer, to reduce the number of objects to process

(setq ss  (ssget "_X" '((-4 . "<OR") (-4 . "<AND") (0 . "CIRCLE")(8 . "CIRCLELAYER")(-4 . "AND>")
					 (-4 . "<AND") (0 . "LWPOLYLINE")(70 . 1)(8 . "LWPOLYLINELAYER")
				 (-4 . "AND>")  (-4 . "OR>")(410 . "Model"))))

Otherwise, take out the "_X" so the user can select via window selection.

HTH

[phanaem]

Hi pBe

Your lisp depends on objects' order.

Here is another approach, using multiple selections.

(defun c:test ( / ss i lst e a ss1 e1)
  (if
    (or
      (setq ss (ssget "_I" '((0 . "LWPOLYLINE,CIRCLE"))))
      (setq ss (ssget '((0 . "LWPOLYLINE,CIRCLE"))))
    )
    (progn
      (repeat (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i)))
              a (vlax-curve-getarea e)
              lst (cons (cons a e) lst)
        )
      )
      (setq lst
        (mapcar 'cdr
          (vl-sort lst
            '(lambda (a b) (> (car a) (car b)))
          )
        )
      )
      (while lst
        (setq e (car lst) lst (cdr lst))
        (if
          (setq ss1 (ssget "_CP" (pts_list e) '((0 . "LWPOLYLINE,CIRCLE"))))
          (repeat (setq i (sslength ss1))
            (setq e1 (ssname ss1 (setq i (1- i))))
            (if
              (not (eq e1 e))
              (progn
                (ssdel e1 ss)
                (setq lst (vl-remove e1 lst))
              )
            )
          )
        )
      )
      (sssetfirst nil ss)
    )
  )
  (princ)
)

(defun pts_list (e / pts a b)
  (if
    (eq (cdr (assoc 0 (entget e))) "CIRCLE")
    (setq pts
      (mapcar
        '(lambda (x)
           (vlax-curve-getpointatparam e (* pi x))
         )
        '(0.0 0.2 0.4 0.6 0.8 1.0 1.2 1.4 1.6 1.8)
      )
    )
    (progn
      (setq a (vlax-curve-getstartparam e)
            b (vlax-curve-getendparam e)
            )
      (while (<= a b)
        (setq pts (cons (vlax-curve-getpointatparam e a) pts))
        (if
          (equal '(0 0 0) (vlax-curve-getsecondderiv e a) 1e-5)
          (setq a (1+ a))
          (setq a (+ 0.2 a))
        )
      )
    )
  )
  pts
)

[pbejse]

---

@phanaem wrote:

Hi pBe

Your lisp depends on objects' order...

---

Good catch.

(if	(setq collection nil ss  (ssget  '((-4 . "<OR")  (0 . "CIRCLE")
					 (-4 . "<AND") (0 . "LWPOLYLINE")(70 . 1)
					 (-4 . "AND>")  (-4 . "OR>")(410 . "Model"))))
        
    (progn
          (repeat (setq i (sslength ss))
                (setq e (ssname ss (setq i (1- i))))
                (setq collection (cons (list (plc e) (vlax-ename->vla-object e) (vlax-curve-getarea e))  collection)))
          
          (setq collection (vl-sort collection '(lambda (a b)
                                                      (< (caddr a)(caddr b)))))
                     
          (while (setq a (Car collection))
                 (setq b (cdr collection))
                (Vla-put-layer (cadr a)
		 (if (vl-some (function (lambda (o)
	                                         (if (_inside-p (Car a) (cadr o))
                                                     (setq f o))))
	                      b)
                     "Inside" "Outside")
                      )
                (setq collection b))
          )
        )

[pbejse]

It appears that multiple selections approach is faster and gives better results, I should've considered only objects that are completely inside a polyline or circle.

Nice thinking phanaem

[Anonymous]

Hi pbejse and phanaem,

Thank you both very much for taking a look at my problem.

I tested both lisps and found the suggestion from phanaem most useful. This quickly marks the outer polylines. I do however have one outer polyline for which the inner polylines are also marked. Do you have any ideas which defects on a closed 2D polyline could make it "transparent" to this lisp?

Thank you very much for your help.

Best regards 

[phanaem]

Without seeing the dwg, I can only guess.
The outer polyline might be a heavy polyline. Try to change LWPOLYLINE to *POLYLINE.

[Anonymous]

I scissored some parts out, which are similar but do not react the same to this lisp.

Please see the attached dwg.

the *POLYLINE didn't work for me.

Thank you.

[phanaem · Accepted solution]

---

@Anonymous wrote:

I scissored some parts out, which are similar but do not react the same to this lisp.

Please see the attached dwg.

the *POLYLINE didn't work for me.

Thank you.

---

Somehow, I was expecting this error.... You can use a smaller interval for bulged segments - like (setq a (+ 0.05 a)) - but this is just a trick, not a solution.

This lisp works on your dwg test, but I'm not sure it is error free

(defun c:test ( / ss i lst e a ss1 e1)
  (if
    (or
      (setq ss (ssget "_I" '((0 . "*POLYLINE,CIRCLE"))))
      (setq ss (ssget '((0 . "*POLYLINE,CIRCLE"))))
    )
    (progn
      (repeat (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i)))
              a (vlax-curve-getarea e)
              lst (cons (cons a e) lst)
        )
      )
      (setq lst
        (mapcar 'cdr
          (vl-sort lst
            '(lambda (a b) (> (car a) (car b)))
          )
        )
      )
      (while lst
        (setq e (car lst) lst (cdr lst))
        (if
          (setq ss1 (ssget "_CP" (pts_list e) '((0 . "*POLYLINE,CIRCLE"))))
          (repeat (setq i (sslength ss1))
            (setq e1 (ssname ss1 (setq i (1- i))))
            (if
              (not (eq e1 e))
              (progn
                (ssdel e1 ss)
                (setq lst (vl-remove e1 lst))
              )
            )
          )
        )
      )
      (sssetfirst nil ss)
    )
  )
  (princ)
)

(defun pts_list (e / pts a b c)
  (if
    (eq (cdr (assoc 0 (entget e))) "CIRCLE")
    (setq pts
      (mapcar
        '(lambda (x)
           (vlax-curve-getpointatparam e (* pi x))
         )
        '(0.0 0.2 0.4 0.6 0.8 1.0 1.2 1.4 1.6 1.8)
      )
    )
    (progn
      (setq a (vlax-curve-getstartparam e)
            b (vlax-curve-getendparam e)
            )
      (while (< a b)
        (setq pts (cons (vlax-curve-getpointatparam e a) pts))
        (or
          (equal '(0 0 0) (vlax-curve-getsecondderiv e a) 1e-5)
          (progn
            (setq c a)
            (repeat 9
              (setq c (+ 0.1 c)
                    pts (cons (vlax-curve-getpointatparam e c) pts)
              )
            )
          )
        )
        (setq a (1+ a))
      )
    )
  )
  pts
)

[marko_ribar]

I suppose you need something like this, but you have to test it further more...

(defun c:colornestinglevels ( / *error* adoc hpis hpbr ss i l ae ci pp p1 p2 mp1 mp2 el ch ll as )

  (vl-load-com)

  (defun *error* ( m )
    (if hpis
      (setvar 'hpislanddetection hpis)
    )
    (if hpbr
      (setvar 'hpboundretain hpbr)
    )
    (if adoc
      (vla-endundomark adoc)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (setq hpis (getvar 'hpislanddetection))
  (setvar 'hpislanddetection 0)
  (setq hpbr (getvar 'hpboundretain))
  (setvar 'hpboundretain 1)
  (setq ss (ssget "_:L"))
  (if ss
    (repeat (setq i (sslength ss))
      (setq l (cons (list (vlax-curve-getarea (ssname ss (setq i (1- i)))) (ssname ss i)) l))
    )
  )
  (vl-cmdf "_.CHANGE" ss "" "_P" "_LA" "0" "_C" "ByLayer" "")
  (setq l (vl-sort l (function (lambda ( a b ) (> (car a) (car b))))))
  (entupd (cdr (assoc -1 (entmod (append (entget (cadar l)) (list (cons 62 10)))))))
  (while (setq ae (car l))
    (setq ci (entmakex (list '(0 . "CIRCLE") (cons 10 (vlax-curve-getstartpoint (cadr ae))) (cons 40 0.25))))
    (setq pp (vlax-invoke (vlax-ename->vla-object (cadr ae)) 'intersectwith (vlax-ename->vla-object ci) acextendnone))
    (entdel ci)
    (setq p1 (list (nth 0 pp) (nth 1 pp) (nth 2 pp)) p2 (list (nth 3 pp) (nth 4 pp) (nth 5 pp)))
    (setq mp1 (mapcar (function /) (mapcar (function +) p1 p2) (list 2.0 2.0 2.0)))
    (setq mp1 (polar (vlax-curve-getstartpoint (cadr ae)) (angle (vlax-curve-getstartpoint (cadr ae)) mp1) 0.25))
    (setq mp2 (mapcar (function +) (vlax-curve-getstartpoint (cadr ae)) (mapcar (function -) mp1 (vlax-curve-getstartpoint (cadr ae)))))
    (setq el (entlast))
    (vl-cmdf "_.BOUNDARY" "_non" mp1)
    (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
    (if (not (eq el (entlast)))
      (progn
        (setq ch 1)
        (while (setq el (entnext el))
          (setq ll (cons (list (vlax-curve-getarea el) el) ll))
        )
      )
      (progn
        (setq ch 2)
        (vl-cmdf "_.BOUNDARY" "_non" mp2)
        (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
        (while (setq el (entnext el))
          (setq ll (cons (list (vlax-curve-getarea el) el) ll))
        )
      )
    )
    (setq ll (vl-sort ll (function (lambda ( a b ) (> (car a) (car b))))))
    (if (> (caar ll) (car ae))
      (progn
        (foreach ael ll
          (entdel (cadr ael))
        )
        (setq ll nil)
        (cond
          ( (= ch 1)
            (setq el (entlast))
            (vl-cmdf "_.BOUNDARY" "_non" mp2)
            (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
            (while (setq el (entnext el))
              (setq ll (cons (list (vlax-curve-getarea el) el) ll))
            )
          )
          ( (= ch 2)
            (setq el (entlast))
            (vl-cmdf "_.BOUNDARY" "_non" mp1)
            (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
            (while (setq el (entnext el))
              (setq ll (cons (list (vlax-curve-getarea el) el) ll))
            )
          )
        )
      )
    )
    (setq ll (vl-sort ll (function (lambda ( a b ) (> (car a) (car b))))))
    (if (setq as (assoc 62 (entget (cadar (vl-member-if (function (lambda ( x ) (equal (caar ll) (car x) 1e-6))) l)))))
      (foreach ael (cdr ll)
        (entupd (cdr (assoc -1 (entmod (append (entget (cadar (vl-member-if (function (lambda ( x ) (equal (car ael) (car x) 1e-6))) l))) (list (cons 62 (+ (cdr as) 2))))))))
      )
      (progn
        (entupd (cdr (assoc -1 (entmod (append (entget (cadar (vl-member-if (function (lambda ( x ) (equal (caar ll) (car x) 1e-6))) l))) (list (cons 62 10)))))))
        (foreach ael (cdr ll)
          (entupd (cdr (assoc -1 (entmod (append (entget (cadar (vl-member-if (function (lambda ( x ) (equal (car ael) (car x) 1e-6))) l))) (list (cons 62 12)))))))
        )
      )
    )
    (foreach ael ll
      (entdel (cadr ael))
    )
    (setq l (cdr l) ll nil)
  )
  (*error* nil)
)

P.S. I wrote this according to your first post where you described resulting colored entities...

HTH., M.R.

[Anonymous]

---

@phanaem wrote:

---

@Anonymous wrote:

I scissored some parts out, which are similar but do not react the same to this lisp.

Please see the attached dwg.

the *POLYLINE didn't work for me.

Thank you.

---

Somehow, I was expecting this error.... You can use a smaller interval for bulged segments - like (setq a (+ 0.05 a)) - but this is just a trick, not a solution.

This lisp works on your dwg test, but I'm not sure it is error free

(defun c:test ( / ss i lst e a ss1 e1)
  (if
    (or
      (setq ss (ssget "_I" '((0 . "*POLYLINE,CIRCLE"))))
      (setq ss (ssget '((0 . "*POLYLINE,CIRCLE"))))
    )
    (progn
      (repeat (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i)))
              a (vlax-curve-getarea e)
              lst (cons (cons a e) lst)
        )
      )
      (setq lst
        (mapcar 'cdr
          (vl-sort lst
            '(lambda (a b) (> (car a) (car b)))
          )
        )
      )
      (while lst
        (setq e (car lst) lst (cdr lst))
        (if
          (setq ss1 (ssget "_CP" (pts_list e) '((0 . "*POLYLINE,CIRCLE"))))
          (repeat (setq i (sslength ss1))
            (setq e1 (ssname ss1 (setq i (1- i))))
            (if
              (not (eq e1 e))
              (progn
                (ssdel e1 ss)
                (setq lst (vl-remove e1 lst))
              )
            )
          )
        )
      )
      (sssetfirst nil ss)
    )
  )
  (princ)
)

(defun pts_list (e / pts a b c)
  (if
    (eq (cdr (assoc 0 (entget e))) "CIRCLE")
    (setq pts
      (mapcar
        '(lambda (x)
           (vlax-curve-getpointatparam e (* pi x))
         )
        '(0.0 0.2 0.4 0.6 0.8 1.0 1.2 1.4 1.6 1.8)
      )
    )
    (progn
      (setq a (vlax-curve-getstartparam e)
            b (vlax-curve-getendparam e)
            )
      (while (< a b)
        (setq pts (cons (vlax-curve-getpointatparam e a) pts))
        (or
          (equal '(0 0 0) (vlax-curve-getsecondderiv e a) 1e-5)
          (progn
            (setq c a)
            (repeat 9
              (setq c (+ 0.1 c)
                    pts (cons (vlax-curve-getpointatparam e c) pts)
              )
            )
          )
        )
        (setq a (1+ a))
      )
    )
  )
  pts
)

---

Thank you for your suggestion, phanaem.

Can you pinpoint exactly which number I need to decrease for bulged parts? Mayby, you can explain in words, what the lisp does?

Best regards

[phanaem]

---

@Anonymous wrote:

Thank you for your suggestion, phanaem.

Can you pinpoint exactly which number I need to decrease for bulged parts? Mayby, you can explain in words, what the lisp does?

Best regards

---

Basically, my lisp creates a list of points for each polyline/circle and then uses this list to create a new selection set via Cross Polygon. The objects found inside this new selection are removed from the original selection.

The problem is with the bulged polyline. The bulged segments needs to be approximate with smaller straight segments. Smaller the segments, the better approximation. That was the suggestion for the first lisp, because the pts_list function sometimes return a bad point list (is something about a cumulative error due to repetitive addition. It is a well known issue)

In the second lisp, pts_list function is modified to avoid this error, so no need to change the first lisp, just use the second.

In the image, you can see the difference between 2 increment values for the first pts_list function (red and blue polys) and the second pts_list function (green)

[marko_ribar]

This is info for lisp I posted... Try to avoid selection of entities with the same areas at different locations - copies of entities or similar... I haven't accounted location condition into lisp, so in some cases it may occur that wrong color is applied to entity for which CAD haven't considered location condition... I leave further modifications to you (prompt for specifying only closed entities while selection, then one single big (progn) if ss exist, then your intervention for location condition,...); error handler exist and core lisp is already defined... I am looking forward to see what you achieved OP...

Regards, M.R.

[phanaem]

kbs,

I just want you to know that my lisp is by no means a complete lisp. You might need to set an error trap, use some filters for the initial selection set and adapt the lisp for any View/Ucs.

ssget "_CP" takes points in the current UCS, but pts_list returns a list of points in WCS.

[marko_ribar]

FYI, Until I don't get a kudo, I won't post my revision...