Topic: -={ Challenge }=- Enclose lines

[zak26]

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

[Lee Mac]

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.  
123. (vl-load-com)
124. (princ)

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.  
21. (princ)

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]

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.

[kdub_nz]

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 ?

[zak26]

. . . 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]

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.

[ScottMC]

Excellant Marco! It does so well.

[liuhe]

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

[ribarm]

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.