from points to groups of points

Moshe-A · ‎03-16-2021

Dear Experts,

Have a difficulty to finish >> this thread << and i'm asking for your help.

bellow is the code i have so far... variable 'cross' is a list collecting all intersect points. what i need is functions to return a list with groups of points in this format:

grp0 grp1 grp2

( ((x y z)) ((x y z) (x y z)) ((x y z) (x y z) (x y z)) ........)

in a group all points must fall in < cmrk-fazz (a variable in program) from each other.

in >> this thread << you will find more info you need including a sample dwg to test.

thanks in advance

Moshe

(defun c:cmrk (/ askreal is_intersect double->lst ; local functions
                 CMRK-FUZZ ss data ename0 ename1 pline0 pline1 rgn1 rgnUnion doubles points)

 (defun askreal (def)
  (initget 4)
  (if (not (setq ask (getreal (strcat "\ncmrk-fuzz <" (rtos def 2) ">: "))))
   (setq ask def)
   (setq def ask)
  )
 ); askreal

  
 (defun is_intersect (o0 o1 / r)
  (if
   (not
     (vl-catch-all-error-p
       (setq r (vl-catch-all-apply 'vlax-invoke (list o0 'IntersectWith o1 acExtendNone)))
     )
   )
   r
  )
 ); is_intersect

  
 (defun double->lst (doubles / _index i lst)
  (setq _index (lambda (b inc) (+ (* b 3) inc)))
   
  (setq i -1)
  (repeat (/ (length doubles) 3)
   (setq i (1+ i)) 
   (setq lst (cons (list (nth (_index i 0) doubles) (nth (_index i 1) doubles) (nth (_index i 2) doubles)) lst))
  )
  
  lst
 ); double->lst

  
 ; here start c:cmrk
 (setvar "cmdecho" 0)
 (command "._undo" "_begin")

 (setq cross nil)
  
 (if (= (getvar "userr1") 0)
  (setq def-fuzz (setvar "userr1" 1e-2))
  (setq def-fuzz (getvar "userr1"))
 )
 
 (if (and
       (setvar "userr1" (setq cmrk-fuzz (askreal def-fuzz)))
       (setq ss (ssget '((0 . "lwpolyline") (70 . 1)))) ; select closed polylines
     )
  (progn
   (setq data (mapcar '(lambda (ename) ename) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
   
   (foreach ename0 (reverse (cdr (reverse data)))
    (setq pline0 (vlax-ename->vla-object ename0))
      
    (foreach ename1 (cdr (member ename0 data))
     (setq pline1 (vlax-ename->vla-object ename1))

     (if (setq doubles (is_intersect pline0 pline1))
      (progn
       (command ".region" "_si" (vlax-vla-object->ename (vla-copy pline0)))
       (setq rgn0 (entlast))
       
       (command ".region" "_si" (vlax-vla-object->ename (vla-copy pline1))) 
       (setq rgn1 (entlast)) 

       (command "._union" rgn0 rgn1 "")  
       (setq rgnUnion (vlax-ename->vla-object (entlast)))

       (if (and
             (not (equal (vla-get-area rgnUnion) (+ (vlax-curve-getarea pline0) (vlax-curve-getarea pline1)) 0.0))
             (setq points (double->lst doubles))
           )
        (setq cross (append cross points))
       ); if
        
       (vla-delete rgnUnion)
       (vlax-release-object rgnUnion)
      ); progn
     ); if

     (vlax-release-object pline1)
    ); foreach

    (vlax-release-object pline0)
   ); foreach

  ); progn
 ); if

 (command "._undo" "_end")
 (setvar "cmdecho" 0)
  
 (princ)
); c:cmrk

CodeDing · ‎03-16-2021

@Moshe-A ,

I did not test with all of your other stuff, but based on your description, I think this will accomplish what you are asking for. Maybe you can refine it further, worth a try.

;; ptList - list, of points
;; cmrk-fazz - int/real, of "fuzz" distance
;; returns - list, of 'grouped' points determined by "fuzz" factor
(defun GroupByFazz (ptList cmrk-fazz / grpList grpRemove first)
  (while ptList
    (if (> (length ptList) 1)
      (setq grpList
        (cons
          (setq grpRemove
            (cons
              (setq first (car ptList))
              (vl-remove-if-not
                '(lambda (pt) (< (distance first pt) cmrk-fazz))
                (cdr ptList)
              );vl
            );cons
          );setq
          grpList
        );cons
      );setq
    ;else
      (setq grpList (cons (setq grpRemove ptList) grpList))
    );if
    (foreach pt grpRemove
      (setq ptList (subst nil pt ptList))
    );foreach
    (setq ptList (vl-remove-if 'null ptList))
  );while
  grpList
);defun

Best,

~DD

ronjonp · ‎03-16-2021

Here is another for fun 🍻 (edit refactored '_groupbyfuzz ' as subfunction)

(defun c:foo (/ _int _groupbyfuzz a b f r s)
  ;; RJP » 2021-03-16
  (defun _int (o1 o2 / p r)
    (if	(= 'list (type (setq p (vl-catch-all-apply 'vlax-invoke (list o1 'intersectwith o2 0)))))
      (repeat (/ (length p) 3) (setq r (cons (mapcar '+ p '(0 0 0)) r)) (setq p (cdddr p)))
    )
    r
  )
  (defun _groupbyfuzz (l f / a b r)
    (while (car l)
      (setq a (car l))
      (setq b (vl-remove-if-not '(lambda (x) (equal a x f)) l))
      (foreach c (append (list a) b) (setq l (vl-remove c l)))
      (setq r (cons b r))
    )
    r
  )
  (cond
    ((and (setq s (ssget '((0 . "~INSERT"))))
	  (setq f (getdist "\nPick fuzz distance: "))
	  (setq s (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))))
     )
     ;; Gather intersection points in 'r'
     (while (cadr s)
       (setq a (car s))
       (foreach p (setq s (cdr s)) (and (setq b (_int a p)) (setq r (cons b r))))
     )
     ;; Append the list of lists and group by a fuzz value in 'r'
     (setq r (_groupbyfuzz (apply 'append r) f))
     ;; List of grouped points
     r
    )
  )
  (princ)
)

ВeekeeCZ · ‎03-16-2021

@Moshe-A wrote:

in a group all points must fall in < cmrk-fazz (a variable in program) from each other.

Question. How many groups are on the picture if fuzz is 1. Is it one or two?

BTW THIS task is the pretty much about it too.

ronjonp · ‎03-17-2021

@ВeekeeCZ wrote:
@Moshe-A wrote:
in a group all points must fall in < cmrk-fazz (a variable in program) from each other.

Question. How many groups are on the picture if fuzz is 1. Is it one or two?

BTW THIS task is the pretty much about it too.

@ВeekeeCZ I say one if you sort it correctly 😎

(defun c:foo2 (/ _int _ap _groupbyfuzz2 a b c d f r r2 s)
  ;; RJP » 2021-03-17
  (defun _int (o1 o2 / p r)
    (if	(= 'list (type (setq p (vl-catch-all-apply 'vlax-invoke (list o1 'intersectwith o2 0)))))
      (repeat (/ (length p) 3) (setq r (cons (mapcar '+ p '(0 0 0)) r)) (setq p (cdddr p)))
    )
    r
  )
  (defun _ap (l / r)
    (setq r '(0 0 0))
    (foreach p l (setq r (mapcar '+ p r)))
    (mapcar '/ r (list (length l) (length l) (length l)))
  )
  (defun _groupbyfuzz2 (l f / a b c r)
    (while (car l)
      (setq a (car l))
      (setq b (vl-remove-if-not '(lambda (x) (equal a x (* f 2.))) l))
      (setq c (_ap b))
      (setq b (vl-sort b '(lambda (r j) (< (distance c r) (distance c j)))))
      (setq r (cons (setq b (vl-remove-if-not '(lambda (x) (equal (car b) x f)) b)) r))
      (foreach p b (setq l (vl-remove p l)))
    )
    r
  )
  (cond
    ((and (setq s (ssget '((0 . "~INSERT"))))
	  (setq f (getdist "\nPick fuzz distance: "))
	  (setq s (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))))
     )
     ;; Gather intersection points in 'r'
     (while (cadr s)
       (setq a (car s))
       (foreach p (setq s (cdr s)) (and (setq b (_int a p)) (setq r (cons b r))))
     )
     ;; Append the list of lists and group by a fuzz value in 'r'
     (setq r (_groupbyfuzz2 (apply 'append r) f))
     ;; List of grouped points
     r
    )
  )
  (princ)
)

Moshe-A · ‎03-17-2021

@ronjonp + @CodeDing

well well guys 😀, both programs works splendid

ronjonp your is extraordinary short and efficient.

thank you very much

Moshe

ronjonp · ‎03-17-2021

@Moshe-A Glad to help 🙂 .. did you try the 'foo2' variant?

Moshe-A · ‎03-17-2021

i used only (_groupbyfuzz)

ronjonp · ‎03-17-2021

@Moshe-A

This one should create less groups.

CodeDing · ‎03-17-2021

I tried to take some pointers from @ronjonp 😅

I have no ide if this would be fast or slow. Just seemed fun to try.

(defun GroupByFazz (ptList cmrk-fazz / len ptAvg grpList first)
  (while (and ptList
              (setq len (length ptList))
              (setq ptAvg
                (mapcar
                  '(lambda (n) (/ n len))
                  (mapcar
                    '(lambda (f) (apply '+ (mapcar f ptList)))
                    '(car cadr caddr)
                  );mapcar
                );mapcar
              );setq
              (setq ptList
                (vl-sort
                  ptList
                  '(lambda (a b) (< (distance ptAvg a) (distance ptAvg b)))
                );vl-sort
              );setq
         );and
    (setq grpList
      (cons
        (mapcar
          '(lambda (ptR) (setq ptList (vl-remove ptR ptList)) ptR)
          (cons
            (setq first (car ptList))
            (vl-remove-if-not
              '(lambda (pt) (equal first pt cmrk-fazz))
              (cdr ptList)
            );vl
          );cons
        );mapcar
        grpList
      );cons
    );setq
  );while
  grpList
);defun

Best,

~DD

Community

from points to groups of points

from points to groups of points

from points to groups of points