Author Topic: -={ Challenge }=- Enclose lines  (Read 5726 times)

0 Members and 1 Guest are viewing this topic.

zak26

  • Newt
  • Posts: 33
Re: -={ Challenge }=- Enclose lines
« Reply #60 on: July 04, 2023, 12:38:41 PM »
It is worth noting that, for an arbitrary point list, the problem becomes this -

https://www.theswamp.org/index.php?topic=30434.0
You're right for arbritrary or Lbracket-Rbracket-shapes, the code I posted initially works pretty well and this includes a modified version of your solution on the link, but it just doesn't solve well the problem I had on just parallel lines, probably the other solutions posted by domenicomania or El Jefe or kasmo work much better
« Last Edit: July 04, 2023, 02:58:00 PM by zak26 »

Lee Mac

  • Seagull
  • Posts: 12912
  • London, England
Re: -={ Challenge }=- Enclose lines
« Reply #61 on: July 04, 2023, 01:55:45 PM »
FWIW, this was my approach -

Code - Auto/Visual Lisp: [Select]
  1. ;; Chain Points  -  Lee Mac
  2. ;; Constructs an LWPolyline passing through all points in the supplied list
  3. ;; lst - [lst] List of 2D points
  4.  
  5. (defun LM:chainpoints ( lst / di1 di2 ent pt1 rtn tmp )
  6.     (setq rtn (LM:convexhull lst)
  7.           lst (vl-remove-if '(lambda ( a ) (vl-some '(lambda ( b ) (equal a b 1e-6)) rtn)) lst)
  8.           ent
  9.         (entmakex
  10.             (append
  11.                 (list
  12.                    '(000 . "LWPOLYLINE")
  13.                    '(100 . "AcDbEntity")
  14.                    '(100 . "AcDbPolyline")
  15.                     (cons 090 (length rtn))
  16.                    '(070 . 1)
  17.                 )
  18.                 (mapcar '(lambda ( x ) (cons 10 x)) rtn)
  19.             )
  20.         )
  21.     )
  22.     (while
  23.         (progn
  24.             (setq pt1 (car lst))
  25.             (while (and pt1 (equal 0.0 (setq di1 (distance pt1 (vlax-curve-getclosestpointto ent pt1))) 1e-6))
  26.                 (setq lst (cdr lst)
  27.                       pt1 (car lst)
  28.                 )
  29.             )
  30.             pt1
  31.         )
  32.         (setq tmp nil)
  33.         (foreach pt2 (cdr lst)
  34.             (if (and (< (setq di2 (distance pt2 (vlax-curve-getclosestpointto ent pt2))) di1) (not (equal 0.0 di2 1e-6)))
  35.                 (setq di1 di2
  36.                       pt1 pt2
  37.                 )
  38.             )
  39.         )
  40.         (repeat (1+ (fix (+ (vlax-curve-getparamatpoint ent (vlax-curve-getclosestpointto ent pt1)) 1e-6)))
  41.             (setq tmp (cons (car rtn) tmp)
  42.                   rtn (cdr rtn)
  43.             )
  44.         )
  45.         (setq rtn (append (reverse tmp) (list pt1) rtn)
  46.               lst (vl-remove-if '(lambda ( x ) (equal x pt1 1e-6)) lst)
  47.         )
  48.         (entmod
  49.             (append
  50.                 (list
  51.                     (cons -1 ent)
  52.                    '(000 . "LWPOLYLINE")
  53.                    '(100 . "AcDbEntity")
  54.                    '(100 . "AcDbPolyline")
  55.                     (cons 090 (length rtn))
  56.                    '(070 . 1)
  57.                 )
  58.                 (mapcar '(lambda ( x ) (cons 10 x)) rtn)
  59.             )
  60.         )
  61.     )
  62. )
  63.  
  64. ;; Convex Hull  -  Lee Mac
  65. ;; Implements the Graham Scan Algorithm to return the Convex Hull of a list of points.
  66. ;; lst - [lst] List of 2D points
  67.  
  68. (defun LM:ConvexHull ( lst / 2pi hul pt0 )
  69.     (cond
  70.         (   (< (length lst) 4)
  71.             lst
  72.         )
  73.         (   (setq 2pi (+ pi pi)
  74.                   pt0 (car lst)
  75.             )
  76.             (foreach pt1 (cdr lst)
  77.                 (if (or (< (cadr pt1) (cadr pt0))
  78.                         (and (equal (cadr pt1) (cadr pt0) 1e-8) (< (car pt1) (car pt0)))
  79.                     )
  80.                     (setq pt0 pt1)
  81.                 )
  82.             )
  83.             (setq lst
  84.                 (vl-sort lst
  85.                     (function
  86.                         (lambda ( a b / c d )
  87.                             (setq c (angle pt0 a)
  88.                                   d (angle pt0 b)
  89.                             )
  90.                             (if (equal c 2pi 1e-6) (setq c 0.0))
  91.                             (if (equal d 2pi 1e-6) (setq d 0.0))
  92.                             (if (equal c d 1e-6)
  93.                                 (< (distance pt0 a) (distance pt0 b))
  94.                                 (< c d)
  95.                             )
  96.                         )
  97.                     )
  98.                 )
  99.             )
  100.             (setq hul (list (cadr lst) (car lst)))        
  101.             (foreach pt (cddr lst)
  102.                 (setq hul (cons pt hul))                
  103.                 (while (and (caddr hul) (LM:clockwise-p (caddr hul) (cadr hul) pt))
  104.                     (setq hul (cons pt (cddr hul)))
  105.                 )
  106.             )
  107.             hul
  108.         )
  109.     )
  110. )
  111.  
  112. ;; Clockwise-p  -  Lee Mac
  113. ;; Returns T if p1,p2,p3 are clockwise oriented or collinear
  114.                  
  115. (defun LM:clockwise-p ( p1 p2 p3 )
  116.     (<  (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
  117.             (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
  118.         )
  119.         1e-8
  120.     )
  121. )
  122.  

And a program to test:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:test ( / enx idx lst sel )
  2.     (if (setq sel (ssget '((0 . "LINE"))))
  3.         (progn
  4.             (repeat (setq idx (sslength sel))
  5.                 (setq idx (1- idx)
  6.                       enx (entget (ssname sel idx))
  7.                       lst (consunique (cdr (assoc 10 enx)) lst)
  8.                       lst (consunique (cdr (assoc 11 enx)) lst)
  9.                 )
  10.             )
  11.             (LM:chainpoints lst)
  12.         )
  13.     )
  14.     (princ)
  15. )
  16.  
  17. (defun consunique ( pnt lst )
  18.     (if (vl-some '(lambda ( x ) (equal x pnt 1e-6)) lst) lst (cons pnt lst))
  19. )
  20.  

Essentially: start with the convex hull and consecutively add the nearest points until the point list is exhausted or the point already lies on the generated polyline.

However, this approach will fail for some concave shapes containing vertices whose inside angle is less than 90 degrees (e.g. crescent shapes).

zak26

  • Newt
  • Posts: 33
Re: -={ Challenge }=- Enclose lines
« Reply #62 on: July 04, 2023, 02:55:01 PM »
it is a very complicated task
It seem that you were right Vovka, because there is no code that can take into account all the possible cases.

I want to thank all the participants that have posted codes and their knoledge to solve this problem, also as the critics, I found it very interesting and pretty good for learning.
« Last Edit: July 04, 2023, 02:59:43 PM by zak26 »

kdub_nz

  • Mesozoic keyThumper
  • SuperMod
  • Water Moccasin
  • Posts: 2132
  • class keyThumper<T>:ILazy<T>
Re: -={ Challenge }=- Enclose lines
« Reply #63 on: July 04, 2023, 04:51:17 PM »
I just noticed something I thought interesting in the first post.

Almost all the corners have been chamfered in the 'new' boundary

. . . so any boundary created from the 'lines' will not replicate the original boundary.

Is the original surrounding geometry still available in the drawing ?

Called Kerry in my other life
Retired; but they dragged me back in !

I live at UTC + 13.00

---
some people complain about loading the dishwasher.
Sometimes the question is more important than the answer.

zak26

  • Newt
  • Posts: 33
Re: -={ Challenge }=- Enclose lines
« Reply #64 on: July 04, 2023, 05:29:49 PM »
. . . so any boundary created from the 'lines' will not replicate the original boundary.
You're right the 'boundary' will follow up to the extents of the limits the lines had, so most of the time will be chamfered

Is the original surrounding geometry still available in the drawing ?
No, as in the problem I had when I had to solve it (like in january of this year) there is no known boundary, just supposed. I created new ones and deleted them just for the examples. but they're all irregular shapes anyone can create.

ribarm

  • Gator
  • Posts: 3255
  • Marko Ribar, architect
Re: -={ Challenge }=- Enclose lines
« Reply #65 on: July 05, 2023, 10:40:08 AM »
Here is my humble version for test1.dwg...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:MR-connect-hatch-lines ( / next collinear-p ss idx li lix p1 p2 lil pts pp rtn p ipli )
  2.  
  3.   (defun next ( p pts )
  4.     (car (vl-sort (vl-remove p pts) '(lambda ( a b ) (< (distance a p) (distance b p)))))
  5.   )
  6.  
  7.   (defun collinear-p ( p1 p p2 )
  8.     (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-6)
  9.   )
  10.  
  11.   (if (setq ss (ssget '((0 . "LINE"))))
  12.     (progn
  13.       (repeat (setq idx (sslength ss))
  14.         (setq li (ssname ss (setq idx (1- idx))))
  15.         (setq p1 (cdr (assoc 10 (setq lix (entget li)))))
  16.         (setq p2 (cdr (assoc 11 lix)))
  17.         (setq lil (cons (list p1 p2) lil))
  18.       )
  19.       (setq p (car (vl-sort (apply 'append lil) '(lambda ( a b ) (if (= (cadr a) (cadr b)) (< (car a) (car b)) (< (cadr a) (cadr b)))))))
  20.       (setq pts (apply 'append lil))
  21.       (setq rtn (cons p rtn))
  22.       (while (and (setq pp (next p pts)) (not (equal p pp 1e-6)))
  23.         (setq lil (vl-sort lil '(lambda ( a b ) (or (< (distance (car a) p) (distance (car b) p)) (< (distance (cadr a) p) (distance (cadr b) p))))))
  24.         (foreach li (reverse lil)
  25.           (if
  26.             (and
  27.               (setq ip (inters (car li) (cadr li) p pp nil))
  28.               (not (equal ip (car li) 1e-6))
  29.               (not (equal ip (cadr li) 1e-6))
  30.               (not (equal ip p 1e-6))
  31.               (not (equal ip pp 1e-6))
  32.               (setq ipli (list ip li))
  33.               (collinear-p p (car ipli) pp)
  34.             )
  35.             (setq pp (car (vl-sort (cadr ipli) '(lambda ( a b ) (< (distance p a) (distance p b))))))
  36.           )
  37.         )
  38.         (if pp
  39.           (setq rtn (cons pp rtn))
  40.         )
  41.         (setq pts (vl-remove p pts))
  42.         (setq p pp)
  43.         (setq ipli nil)
  44.         (if (> (length rtn) 2)
  45.           (if (collinear-p (car rtn) (cadr rtn) (caddr rtn))
  46.             (setq rtn (vl-remove (cadr rtn) rtn))
  47.           )
  48.         )
  49.       )
  50.       (entmake
  51.         (append
  52.           (list
  53.             (cons 0 "LWPOLYLINE")
  54.             (cons 100 "AcDbEntity")
  55.             (cons 100 "AcDbPolyline")
  56.             (cons 90 (length rtn))
  57.             (cons 70 (1+ (* 128 (getvar 'plinegen))))
  58.             (cons 38 0.0)
  59.           )
  60.           (mapcar '(lambda ( p ) (cons 10 p)) rtn)
  61.           (list (list 210 0.0 0.0 1.0))
  62.         )
  63.       )
  64.     )
  65.   )
  66.   (princ)
  67. )
  68.  

Regards, M.R.
« Last Edit: July 07, 2023, 10:02:22 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ScottMC

  • Newt
  • Posts: 191
Re: -={ Challenge }=- Enclose lines
« Reply #66 on: July 05, 2023, 10:12:00 PM »
Excellant Marco! It does so well.

liuhe

  • Mosquito
  • Posts: 8
Re: -={ Challenge }=- Enclose lines
« Reply #67 on: July 07, 2023, 03:33:24 AM »
MY CODE  FOR TEST1.DWG

If it is test2, it will become complex


Code - Auto/Visual Lisp: [Select]
  1.  
  2. (DEFUN C:TT (/ SS I LST1 E ANG P10 P11 ANG1 PC PP ELST LST2 LST3 LST4)
  3.   (SETQ SS (SSGET '((0 . "*LINE"))))
  4.   (IF (NOT SS)
  5.   )
  6.   (SETQ I    0
  7.         LST1 NIL
  8.         E    (SSNAME SS I)
  9.   )
  10.   (REPEAT (SSLENGTH SS)
  11.     (SETQ E    (SSNAME SS I)
  12.           P10  (vlax-curve-getStartPoint E)
  13.           P11  (vlax-curve-getEndPoint E)
  14.           ANG1 (ANGLE P10 P11)
  15.           PC   (MID P10 P11)
  16.     )
  17.     (IF (NOT (EQUAL ANG ANG1 1E-8))
  18.       (PROGN
  19.         (SETQ PP  P10
  20.               P10 P11
  21.               P11 PP
  22.         )
  23.       )
  24.     )
  25.     (SETQ ELST (LIST PC P10 P11)
  26.           LST1 (CONS ELST LST1)
  27.           I    (1+ I)
  28.     )
  29.   )
  30.   (SETQ LST1 (vl-sort LST1
  31.                       (function (lambda (e1 e2)
  32.                                   (< (CAR (car e1)) (CAR (car e2)))
  33.                                 )
  34.                       )
  35.              )
  36.         LST2 (MAPCAR (FUNCTION (LAMBDA (X) (CADR X))) LST1)
  37.         LST3 (MAPCAR (FUNCTION (LAMBDA (X) (CADDR X))) LST1)
  38.         LST4 (APPEND LST2 (REVERSE LST3) (LIST (CAR LST2)))
  39.         E    (Make-LWPOLYLINE lst4)
  40.   )
  41.   (PRINC)
  42. )
  43.  
  44. (defun Make-LWPOLYLINE (lst / PT)
  45.     (append
  46.       (list '(0 . "LWPOLYLINE")
  47.             '(100 . "AcDbEntity")
  48.             '(100 . "AcDbPolyline")
  49.             (cons 90 (length lst))
  50.       )
  51.       (mapcar '(lambda (pt) (cons 10 pt)) lst)
  52.     )
  53.   )
  54. )
  55.  
  56.  
  57. (defun MID (po1 po2)
  58.   (setq po (MAPCAR '(lambda (X Y) (* (+ X Y) 0.5)) po1 po2))
  59. )
  60.  
  61.  

ribarm

  • Gator
  • Posts: 3255
  • Marko Ribar, architect
Re: -={ Challenge }=- Enclose lines
« Reply #68 on: July 07, 2023, 10:01:30 AM »
Your test2.dwg is somewhat corrupted... To get normal LINES you'll have to explode them all firstly... Then, only then will greedy algorithm work...
Here is greedy :

Code - Auto/Visual Lisp: [Select]
  1. (defun c:MR-connect-hatch-lines-greedy ( / next collinear-p ss idx li lix p1 p2 lil pts pp rtn p )
  2.  
  3.   (defun next ( lst cmp / rtn ) ;;; (next) = (car-sort) ;;;
  4.     (setq rtn (car lst))
  5.     (foreach itm (cdr lst)
  6.       (if (apply cmp (list itm rtn))
  7.         (setq rtn itm)
  8.       )
  9.     )
  10.     rtn
  11.   )
  12.  
  13.   (defun collinear-p ( p1 p p2 )
  14.     (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-6)
  15.   )
  16.  
  17.   (if (setq ss (ssget '((0 . "LINE"))))
  18.     (progn
  19.       (repeat (setq idx (sslength ss))
  20.         (setq li (ssname ss (setq idx (1- idx))))
  21.         (setq p1 (cdr (assoc 10 (setq lix (entget li)))))
  22.         (setq p2 (cdr (assoc 11 lix)))
  23.         (setq lil (cons (list p1 p2) lil))
  24.       )
  25.       (setq p (next (setq pts (apply 'append lil)) '(lambda ( a b ) (if (= (cadr a) (cadr b)) (< (car a) (car b)) (< (cadr a) (cadr b))))))
  26.       (setq rtn (cons p rtn))
  27.       (while (and (setq pp (next (setq pts (vl-remove p pts)) '(lambda ( a b ) (< (distance a p) (distance b p))))) (not (equal p pp 1e-6)))
  28.         (if (and pp (not (vl-position pp rtn)))
  29.           (setq rtn (cons pp rtn))
  30.         )
  31.         (if (> (length rtn) 2)
  32.           (if (collinear-p (car rtn) (cadr rtn) (caddr rtn))
  33.             (setq rtn (vl-remove (cadr rtn) rtn))
  34.           )
  35.         )
  36.         (setq pts (vl-remove p pts))
  37.         (setq p pp)
  38.       )
  39.       (entmake
  40.         (append
  41.           (list
  42.             (cons 0 "LWPOLYLINE")
  43.             (cons 100 "AcDbEntity")
  44.             (cons 100 "AcDbPolyline")
  45.             (cons 90 (length rtn))
  46.             (cons 70 (1+ (* 128 (getvar 'plinegen))))
  47.             (cons 38 0.0)
  48.           )
  49.           (mapcar '(lambda ( p ) (cons 10 p)) rtn)
  50.           (list (list 210 0.0 0.0 1.0))
  51.         )
  52.       )
  53.     )
  54.   )
  55.   (princ)
  56. )
  57.  

HTH., M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube