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

[marko_ribar]

I know that it's not my business but @phanaem did get and solution and 2 kudos on his replies mr @pbejse... Don't you think your posts are valuable too? Maybe I am missing something in OP's request, but I am with impression that my code is somewhat OP's initial goal was about... Just can't see why someone that started this topic is avoiding to thank to us that are replying by giving kudo... I am just like every other member of this forum, the one who wants to help and have the same reasons for doing it - get deserved acknowledgement with kudo or solution... Beside all this there is one wisdom : Who is not for himself, that one is neither for others... So what's the catch, I already wrote revision and no one wants to see it by giving me a kudo - one simple click and that's all... How dumb this is, or folks are that I am trying forcing the people to react...

[pbejse]

---

@marko_ribar wrote:

mr @pbejse... Don't you think your posts are valuable too? ....

---

I don't mind at all not getting kudos marko_ribar,  If not the OP then somebody else might find the post useful, I'm mostly in it for the fun of writing codes. and helping others find a solution [ and learn new stuff from other forum members ] at the same time.

Cheers buddy 

EDIT:  Almost forgot the most important thing there 

[Anonymous]

Hi Marco,

I'm sorry that I didn't recognize you contribtion. I didn't have enought time to test your solution properly before I was off for the weekend.

I have given you a kudo for your effort, but I don't think this is a solution as it is now.

I have attached a screenshot of my result from using the colornestinglevels on all polylines in the test.dwg drawing.

[marko_ribar]

HI @Anonymous... Like I've promised, here is my revision for that code... As addition, if you want to create layers and put entities to them so you can later switch them on/off freeze/thaw there is one more code for that, and if you wish you can combine them into single routine, but to me it's better to leave them separate... After all I don't mind selecting 2 times the same collection of entities - to me it's just a second step...

Revision :

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

  (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)
  (prompt "\nSelect closed curves to color them by nesting levels... Warning : all curves will be put into layer \"0\" before and after coloring...")
  (setq ss (ssget "_:L"))
  (if ss
    (progn
      (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.05))))
        (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.05))
        (setq mp2 (mapcar (function +) (vlax-curve-getstartpoint (cadr ae)) (mapcar (function -) (vlax-curve-getstartpoint (cadr ae)) mp1)))
        (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 (and (> (caar ll) (car ae)) (not (equal (caar ll) (car ae) 1e-6)))
          (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)
            (setq p (vlax-curve-getstartpoint (cadr ael)))
            (entupd (cdr (assoc -1 (entmod (append (entget (cadar (vl-sort (vl-remove-if-not (function (lambda ( x ) (equal (car ael) (car x) 1e-6))) (vl-member-if (function (lambda ( x ) (equal (car ael) (car x) 1e-6))) l)) (function (lambda ( a b ) (< (distance p (vlax-curve-getclosestpointto (cadr a) p)) (distance p (vlax-curve-getclosestpointto (cadr b) p)))))))) (list (cons 62 (+ (cdr as) 2))))))))
          )
          (progn
            (setq p (vlax-curve-getstartpoint (cadar ll)))
            (entupd (cdr (assoc -1 (entmod (append (entget (cadar (vl-sort (vl-remove-if-not (function (lambda ( x ) (equal (caar ll) (car x) 1e-6))) (vl-member-if (function (lambda ( x ) (equal (caar ll) (car x) 1e-6))) l)) (function (lambda ( a b ) (< (distance p (vlax-curve-getclosestpointto (cadr a) p)) (distance p (vlax-curve-getclosestpointto (cadr b) p)))))))) (list (cons 62 10)))))))
            (foreach ael (cdr ll)
              (setq p (vlax-curve-getstartpoint (cadr ael)))
              (entupd (cdr (assoc -1 (entmod (append (entget (cadar (vl-sort (vl-remove-if-not (function (lambda ( x ) (equal (car ael) (car x) 1e-6))) (vl-member-if (function (lambda ( x ) (equal (car ael) (car x) 1e-6))) l)) (function (lambda ( a b ) (< (distance p (vlax-curve-getclosestpointto (cadr a) p)) (distance p (vlax-curve-getclosestpointto (cadr b) p)))))))) (list (cons 62 12)))))))
            )
          )
        )
        (foreach ael ll
          (entdel (cadr ael))
        )
        (setq l (cdr l) ll nil)
      )
    )
  )
  (*error* nil)
)

Additional code :

(defun c:colorents2layers ( / LM:true->rgb ss i e l ee g gg )

  ;; True -> RGB  -  Lee Mac
  ;; Args: c - [int] True Colour

  (defun LM:true->rgb ( c )
    (mapcar (function (lambda ( x ) (lsh (lsh (fix c) x) -24))) '(8 16 24))
  )

  (prompt "\nSelect colored entities to put them into corresponding layers...")
  (setq ss (ssget "_:L"))
  (if ss
    (progn
      (repeat (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i))))
        (setq l (cons (list (assoc 62 (entget e)) (assoc 420 (entget e)) e) l))
      )
      (while (setq ee (car l))
        (setq g (vl-remove-if-not (function (lambda ( x ) (and (equal (car ee) (car x)) (equal (cadr ee) (cadr x))))) l))
        (setq l (vl-remove-if (function (lambda ( x ) (vl-position x g))) l))
        (setq gg (cons g gg))
      )
      (foreach g gg
        (cond
          ( (and (null (caar g)) (null (cadar g)))
            (foreach ee g
              (vl-cmdf "_.CHANGE" (caddr ee) "" "_P" "_LA" "0" "_C" "ByLayer" "")
            )
          )
          ( (and (caar g) (null (cadar g)))
            (if (not (tblsearch "LAYER" (itoa (cdaar g))))
              (progn
                (vl-cmdf "_.-LAYER" "_M" (itoa (cdaar g)) "_C" (itoa (cdaar g)))
                (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
              )
              (progn
                (vl-cmdf "_.-LAYER" "_S" (itoa (cdaar g)) "_C" (itoa (cdaar g)))
                (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
              )
            )
            (foreach ee g
              (vl-cmdf "_.CHANGE" (caddr ee) "" "_P" "_LA" (itoa (cdaar g)) "_C" "ByLayer" "")
            )
          )
          ( (and (null (caar g)) (cadar g))
            (if (not (tblsearch "LAYER" (apply (function strcat) (mapcar (function (lambda ( a b ) (strcat a (itoa b)))) '("RGB-" "-" "-") (LM:true->rgb (cdadar g))))))
              (progn
                (vl-cmdf "_.-LAYER" "_M" (apply (function strcat) (mapcar (function (lambda ( a b ) (strcat a (itoa b)))) '("RGB-" "-" "-") (LM:true->rgb (cdadar g)))) "_C" "_T" (apply (function strcat) (mapcar (function (lambda ( a b ) (strcat a (itoa b)))) '("" "," ",") (LM:true->rgb (cdadar g)))))
                (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
              )
              (progn
                (vl-cmdf "_.-LAYER" "_S" (apply (function strcat) (mapcar (function (lambda ( a b ) (strcat a (itoa b)))) '("RGB-" "-" "-") (LM:true->rgb (cdadar g)))) "_C" "_T" (apply (function strcat) (mapcar (function (lambda ( a b ) (strcat a (itoa b)))) '("" "," ",") (LM:true->rgb (cdadar g)))))
                (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
              )
            )
            (foreach ee g
              (vl-cmdf "_.CHANGE" (caddr ee) "" "_P" "_LA" (apply (function strcat) (mapcar (function (lambda ( a b ) (strcat a (itoa b)))) '("RGB-" "-" "-") (LM:true->rgb (cdadar g)))) "_C" "ByLayer" "")
            )
          )
          ( (and (caar g) (cadar g))
            (if (not (tblsearch "LAYER" (apply (function strcat) (mapcar (function (lambda ( a b ) (strcat a (itoa b)))) '("RGB-" "-" "-") (LM:true->rgb (cdadar g))))))
              (progn
                (vl-cmdf "_.-LAYER" "_M" (apply (function strcat) (mapcar (function (lambda ( a b ) (strcat a (itoa b)))) '("RGB-" "-" "-") (LM:true->rgb (cdadar g)))) "_C" "_T" (apply (function strcat) (mapcar (function (lambda ( a b ) (strcat a (itoa b)))) '("" "," ",") (LM:true->rgb (cdadar g)))))
                (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
              )
              (progn
                (vl-cmdf "_.-LAYER" "_S" (apply (function strcat) (mapcar (function (lambda ( a b ) (strcat a (itoa b)))) '("RGB-" "-" "-") (LM:true->rgb (cdadar g)))) "_C" "_T" (apply (function strcat) (mapcar (function (lambda ( a b ) (strcat a (itoa b)))) '("" "," ",") (LM:true->rgb (cdadar g)))))
                (while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
              )
            )
            (foreach ee g
              (vl-cmdf "_.CHANGE" (caddr ee) "" "_P" "_LA" (apply (function strcat) (mapcar (function (lambda ( a b ) (strcat a (itoa b)))) '("RGB-" "-" "-") (LM:true->rgb (cdadar g)))) "_C" "ByLayer" "")
            )
          )
        )
      )
    )
  )
  (princ)
)

HTH., M.R.

[Anonymous]

Hi Marco,

I still do not get all outer polylines marked, when I run your lisp on the test.dwg, which I posted earlier in this thread. Maybe I am not using it right. Does it work for you?

Please see attached screenshot.

[marko_ribar]

It was a fuzz factors problem... Test it now with supplied default values (just hit ENTER twice after selection) :

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

  (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)
  (prompt "\nSelect closed curves to color them by nesting levels... Warning : all curves will be put into layer \"0\" before and after coloring...")
  (setq ss (ssget "_:L"))
  (initget 6)
  (setq fuzz1 (getdist "\nPick or specify fuzz distance for finding points inside boundaries for argument for BOUNDARY command <0.5> : "))
  (if (null fuzz1)
    (setq fuzz1 0.5)
  )
  (initget 6)
  (setq fuzz2 (getdist "\nPick or specify fuzz distance for tolerances between areas comparation for (equal) function <0.1> : "))
  (if (null fuzz2)
    (setq fuzz2 0.1)
  )
  (if ss
    (progn
      (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 fuzz1))))
        (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) fuzz1))
        (setq mp2 (mapcar (function +) (vlax-curve-getstartpoint (cadr ae)) (mapcar (function -) (vlax-curve-getstartpoint (cadr ae)) mp1)))
        (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 (and (> (caar ll) (car ae)) (not (equal (caar ll) (car ae) fuzz2)))
          (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) fuzz2))) l)))))
          (foreach ael (cdr ll)
            (setq p (vlax-curve-getstartpoint (cadr ael)))
            (entupd (cdr (assoc -1 (entmod (append (entget (cadar (vl-sort (vl-remove-if-not (function (lambda ( x ) (equal (car ael) (car x) fuzz2))) (vl-member-if (function (lambda ( x ) (equal (car ael) (car x) fuzz2))) l)) (function (lambda ( a b ) (< (distance p (vlax-curve-getclosestpointto (cadr a) p)) (distance p (vlax-curve-getclosestpointto (cadr b) p)))))))) (list (cons 62 (+ (cdr as) 2))))))))
          )
          (progn
            (setq p (vlax-curve-getstartpoint (cadar ll)))
            (entupd (cdr (assoc -1 (entmod (append (entget (cadar (vl-sort (vl-remove-if-not (function (lambda ( x ) (equal (caar ll) (car x) fuzz2))) (vl-member-if (function (lambda ( x ) (equal (caar ll) (car x) fuzz2))) l)) (function (lambda ( a b ) (< (distance p (vlax-curve-getclosestpointto (cadr a) p)) (distance p (vlax-curve-getclosestpointto (cadr b) p)))))))) (list (cons 62 10)))))))
            (foreach ael (cdr ll)
              (setq p (vlax-curve-getstartpoint (cadr ael)))
              (entupd (cdr (assoc -1 (entmod (append (entget (cadar (vl-sort (vl-remove-if-not (function (lambda ( x ) (equal (car ael) (car x) fuzz2))) (vl-member-if (function (lambda ( x ) (equal (car ael) (car x) fuzz2))) l)) (function (lambda ( a b ) (< (distance p (vlax-curve-getclosestpointto (cadr a) p)) (distance p (vlax-curve-getclosestpointto (cadr b) p)))))))) (list (cons 62 12)))))))
            )
          )
        )
        (foreach ael ll
          (entdel (cadr ael))
        )
        (setq l (cdr l) ll nil)
      )
    )
  )
  (*error* nil)
)

M.R.