TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: zak26 on June 29, 2023, 11:54:00 AM

Title: -={ Challenge }=- Enclose lines
Post by: zak26 on June 29, 2023, 11:54:00 AM
Hi everyone I want to propose a new challenge, although I'm not sure if it is up to your capabilities because I have seen so many excellent and great programers here and probably this is a very small task for you guys. but here it is, I want you to create a closed polyline that contains all the lines or polylines selected kind of create a boundary.

As you may know I already have my own program that solves the task, and I'll show it later on, so hope you enjoy your small challenge.

I leave a dwg file to make your own trials, here is also a gif that shows how I do it, most surely you can do it much better.
Title: Re: -={ Challenge }=- Enclose lines
Post by: ScottMC on June 29, 2023, 12:31:27 PM
Could see that as useful with exploded hatches..
Title: Re: -={ Challenge }=- Enclose lines
Post by: Lee Mac on June 29, 2023, 01:26:05 PM
Like this? :-)

http://lee-mac.com/swamp/JoinPoints.gif
Title: Re: -={ Challenge }=- Enclose lines
Post by: zak26 on June 29, 2023, 01:32:27 PM
Quote from: Lee Mac on June 29, 2023, 01:26:05 PM
Like this? :-)
Just like that, let's hope there are more people interested. I knew it could be a simple task for you. Lee
Title: Re: -={ Challenge }=- Enclose lines
Post by: It's Alive! on June 30, 2023, 09:47:17 AM
here's mine, i used python though
Title: Re: -={ Challenge }=- Enclose lines
Post by: zak26 on June 30, 2023, 10:30:30 AM
Quote from: El Jefe on June 30, 2023, 09:47:17 AM
here's mine, i used python though
Looks good, two more and I'll show my cards
Title: Re: -={ Challenge }=- Enclose lines
Post by: JohnK on June 30, 2023, 03:18:49 PM
I got a working concept too.

EDIT: I only mocked up with lines though (I'd have to modify to get plines working).
Title: Re: -={ Challenge }=- Enclose lines
Post by: zak26 on June 30, 2023, 03:58:25 PM
Quote from: JohnK on June 30, 2023, 03:18:49 PM
I got a working concept too.

EDIT: I only mocked up with lines though (I'd have to modify to get plines working).
That's great John, glad you joined the Challenge, I hope at the end we can all show our way to solve it.
Title: Re: -={ Challenge }=- Enclose lines
Post by: Stefan on June 30, 2023, 04:30:42 PM
My version
Title: Re: -={ Challenge }=- Enclose lines
Post by: JohnK on June 30, 2023, 04:31:21 PM
It was fun to play with here-and-there all day.

I hacked up a quick fix for dealing with plines so I should be ready for posting my crude solution.
Title: Re: -={ Challenge }=- Enclose lines
Post by: zak26 on June 30, 2023, 04:44:22 PM
Quote from: Stefan on June 30, 2023, 04:30:42 PM
My version
Good, looks like a fast one, and much better than mine, i couldn't get to do it in more than one group at a time.
Title: Re: -={ Challenge }=- Enclose lines
Post by: zak26 on June 30, 2023, 04:53:45 PM
Well as promised here is my version, sometimes to find a solution we stand on the shoulders of gigants to solve our tasks, without this key masterpiece of Lee Mac, I couldn't have done it. (Or maybe yes in time a year or so.). Thanks again for participating in this small Challenge, Thanks Lee for sharing your codes with us. And everyone else here, I have learned a lot from this forums.
Code: [Select]
;;; enl-enclose lines
;;; By Isaac A.
;;; Program to enclose lines with a polyline
(defun c:enl ( / lst oe oo ss )
(vl-load-com)
   (setq oe (getvar 'cmdecho)
         oo (getvar 'osmode))
   (setvar 'cmdecho 0)
   (setvar 'osmode 37)
   (vl-cmdf "_.undo" "_begin")
   (princ "\nSelect the lines to enclose: ")
   (if (setq ss (ssget (list '(0 . "*LINE") )))
      (progn
         (foreach pline (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
            (setq lst (cons (vlax-curve-getStartPoint (vlax-ename->vla-object pline)) lst))
            (setq lst (cons (vlax-curve-getEndPoint   (vlax-ename->vla-object pline)) lst))
         )
         (mkPoly lst)
      )
   )
   (setvar 'cmdecho oe)
   (setvar 'osmode oo)
   (vl-cmdf "_.undo" "_end")
   (princ)
)

;;; Original By Lee Mac modified by Isaac
;;; http://www.theswamp.org/index.php?topic=30434.0
;;; Makes a polyline touching all the points in a list
(defun mkPoly (lst / qsort rslt x)
  (defun qsort (pt lst)
    (vl-sort lst
      (function (lambda (a b) (< (distance pt a) (distance pt b))))))
  (setq rslt (list (car lst)))
  (while (setq x (car (setq lst (qsort (car rslt) (cdr lst)))))
    (setq rslt (cons x rslt))
  )
  (entmakex (append (list '(0 . "LWPOLYLINE")
                          '(100 . "AcDbEntity")
                          '(67 . 0)
                          '(410 . "Model")
                          '(8 . "Test")
                          '(62 . 3)
                          '(100 . "AcDbPolyline")
                           (cons 90 (length rslt))
                          '(70 . 1)
                    )
                    (mapcar (function (lambda (a) (cons 10 a))) rslt)
            )
  )
  (princ)
)
Title: Re: -={ Challenge }=- Enclose lines
Post by: It's Alive! on June 30, 2023, 05:16:38 PM
i used a hull, so it's wrong
Title: Re: -={ Challenge }=- Enclose lines
Post by: VovKa on June 30, 2023, 05:23:29 PM
Quote from: zak26 on June 29, 2023, 11:54:00 AM
probably this is a very small task for you guys
on the contrary
it is a very complicated task
Title: Re: -={ Challenge }=- Enclose lines
Post by: zak26 on June 30, 2023, 05:39:36 PM
Quote from: El Jefe on June 30, 2023, 05:16:38 PM
i used a hull, so it's wrong
I don't see why is wrong, you got to the result at the end, and I'd like to know how to use python with autocad, sounds interesting.
Title: Re: -={ Challenge }=- Enclose lines
Post by: It's Alive! on June 30, 2023, 05:43:00 PM
Quote from: zak26 on June 30, 2023, 05:39:36 PM
Quote from: El Jefe on June 30, 2023, 05:16:38 PM
i used a hull, so it's wrong
I don't see why is wrong, you got to the result at the end, and I'd like to know how to use python with autocad, sounds interesting.

won't work on a "L" shape
Title: Re: -={ Challenge }=- Enclose lines
Post by: zak26 on June 30, 2023, 05:46:36 PM
Quote
on the contrary
it is a very complicated task
I wouldn't think of you saying that, you have created a great program that I haven't seen replicated (IRT), And I'd like to ask you how to work with kml files, but that will be on other ocassion.
Title: Re: -={ Challenge }=- Enclose lines
Post by: ScottMC on June 30, 2023, 07:57:29 PM
Certainly a helpful tool zak26 and Lee Mac!
Exciting thing for those tough situations.
Gotta look at this pgm.
Gile put one out that would help simplify..
https://www.theswamp.org/index.php?topic=19865.msg244892#msg244892
Title: Re: -={ Challenge }=- Enclose lines
Post by: zak26 on June 30, 2023, 08:06:14 PM
Quote from: ScottMC on June 30, 2023, 07:57:29 PM
Certainly a helpful tool zak26 and Lee Mac!
Exciting thing for those tough situations.
Gotta look at this pgm.
Gile put one out that would help simplify..
https://www.theswamp.org/index.php?topic=19865.msg244892#msg244892
Didn't know about this one, I used CAB's psimple, which is a good one too.
Title: Re: -={ Challenge }=- Enclose lines
Post by: JohnK on June 30, 2023, 09:01:15 PM
Here was my mockup. It doesn't do any hand-holding (zero error trapping/checking) but it worked in the tests I tossed at it (and the test drawing you supplied).

Sorry it's not very smooth, I was just chipping away at the program here-and-there in between work tasks all day--and I hacked up the pline handling part in 2 minutes after I thought I was already done.

Code - Auto/Visual Lisp: [Select]
  1. (defun pline-enclosure ( / ss
  2.                            ;; support functions
  3.                            gety
  4.                            getx
  5.                            foreachss
  6.                            drawpoly)
  7.   ;; this is a mockup program which draws a polyline around a selection
  8.   ;; set of lines or plines.
  9.   ;;
  10.   ;; NOTE: I did not implement a sort for these points so if the
  11.   ;;       (poly)lines are not processed "in order" this will
  12.   ;;       draw a wobbly outline.
  13.   ;;
  14.   ;; John Kaul - 2023.06.30
  15.  
  16.           (defun gety (ent)
  17.             ;; get association 10 of ent.
  18.             (cdr (assoc 10 (entget ent))))
  19.           (defun getx (ent / ent code)
  20.             ;; get association 11 (or 10 of polylines) of ent.
  21.             ;; NOTE: The handling of polylines is a bit of a hack
  22.             ;;       but works for this mockup.
  23.             (setq ent (entget ent))
  24.             (setq code (cond
  25.                          ((eq (cdr (assoc 0 ent)) "LWPOLYLINE") (setq ent (reverse ent)) 10)
  26.                          (11)))
  27.             (cdr (assoc code ent)))
  28.           (defun foreachss (ss procedure / lst cntr)
  29.             ;; do something to each item in a selection set.
  30.             (setq cntr 0)
  31.             (if (eq (type ss) 'PICKSET)                 ;; if the selection set is a list of items picked
  32.               (repeat (sslength ss)
  33.                       (setq lst                         ;; create a list
  34.                             (append lst
  35.                                     (list
  36.                                       ((eval procedure) (ssname ss cntr)))))
  37.                       (setq cntr (1+ cntr)))
  38.               '*ERROR*
  39.               );_ end if
  40.             lst
  41.             )
  42.           (defun drawpoly (lst)
  43.             ;; draw a poly line from a list of points.
  44.             (entmakex (append (list (cons 0 "LWPOLYLINE")
  45.                                     (cons 100 "AcDbEntity")
  46.                                     (cons 100 "AcDbPolyline")
  47.                                     (cons 90 (length lst))
  48.                                     (cons 70 1))
  49.                               (mapcar '(lambda (p) (cons 10 p)) lst))))
  50.   (setq ss (ssget))                                     ;; get the items to draw around
  51.  
  52.   (drawpoly                                             ;; draw a polyline
  53.     (append
  54.       (foreachss ss 'gety)
  55.       (reverse (foreachss ss 'getx))
  56.       )
  57.     )
  58.   )


EDIT: Fixed code.
Title: Re: -={ Challenge }=- Enclose lines
Post by: JohnK on June 30, 2023, 09:04:18 PM
Quote from: VovKa on June 30, 2023, 05:23:29 PM
Quote from: zak26 on June 29, 2023, 11:54:00 AM
probably this is a very small task for you guys
on the contrary
it is a very complicated task

wait what!? ...well, I defiantly messed up then (watch, mine probably only works on Tuesdays I bet---every other day it makes toast).
Title: Re: -={ Challenge }=- Enclose lines
Post by: It's Alive! on June 30, 2023, 10:04:57 PM
fixed

Code - Python: [Select]
  1.  
  2. import PyRx as Rx
  3. import PyGe as Ge
  4. import PyGi as Gi
  5. import PyDb as Db
  6. import PyAp as Ap
  7. import PyEd as Ed
  8.  
  9. from ortools.constraint_solver import routing_enums_pb2
  10. from ortools.constraint_solver import pywrapcp
  11.  
  12.  
  13. def PyRxCmd_pydoit():
  14.     try:
  15.         filter = [(Db.DxfCode.kDxfStart, "LINE,LWPOLYLINE")]
  16.         ssres = Ed.Editor.select(filter)
  17.         if ssres[0] != Ed.PromptStatus.eNormal:
  18.             return
  19.    
  20.         points = []
  21.         ss = ssres[1].toList()
  22.         for id in ss:
  23.             if id.isDerivedFrom(Db.Curve.desc()):
  24.                 curve = Db.Curve(id)
  25.                 points.append(curve.getStartPoint())
  26.                 points.append(curve.getEndPoint())
  27.        
  28.         manager = pywrapcp.RoutingIndexManager(len(points) , 1, 0)
  29.         routing = pywrapcp.RoutingModel(manager)
  30.        
  31.         def distance_callback(from_index, to_index):
  32.             from_node = manager.IndexToNode(from_index)
  33.             to_node = manager.IndexToNode(to_index)
  34.             l =  points[from_node]
  35.             r =  points[to_node]
  36.             return int(l.distanceTo(r) * 100)
  37.        
  38.         transit_callback_index = routing.RegisterTransitCallback(distance_callback)
  39.         routing.SetArcCostEvaluatorOfAllVehicles(transit_callback_index)
  40.         search_parameters = pywrapcp.DefaultRoutingSearchParameters()
  41.         search_parameters.first_solution_strategy = (
  42.         routing_enums_pb2.FirstSolutionStrategy.PATH_CHEAPEST_ARC)
  43.         solution = routing.SolveWithParameters(search_parameters)
  44.        
  45.         path = []
  46.         index = routing.Start(0)
  47.         while not routing.IsEnd(index):
  48.             path.append(points[manager.IndexToNode(index)])
  49.             index = solution.Value(routing.NextVar(index))
  50.            
  51.         pathlen = len(path)
  52.         pline = Db.Polyline(pathlen)
  53.  
  54.         for ind in range(0,pathlen):
  55.             p = path[ind]
  56.             pline.addVertexAt(ind, Ge.Point2d(p.x,p.y))
  57.            
  58.         pline.setClosed(True)
  59.         pline.setColorIndex(1)
  60.        
  61.         db = Db.HostApplicationServices().workingDatabase()
  62.         model = Db.BlockTableRecord(db.modelSpaceId(), Db.OpenMode.ForWrite)
  63.         model.appendAcDbEntity(pline)
  64.  
  65.     except Exception as err:
  66.         print(err)
  67.  
  68.  
Title: Re: -={ Challenge }=- Enclose lines
Post by: It's Alive! on June 30, 2023, 10:31:27 PM
enl doesn't like this case
Title: Re: -={ Challenge }=- Enclose lines
Post by: It's Alive! on June 30, 2023, 10:33:52 PM
Quote from: JohnK on June 30, 2023, 09:04:18 PM
Quote from: VovKa on June 30, 2023, 05:23:29 PM
Quote from: zak26 on June 29, 2023, 11:54:00 AM
probably this is a very small task for you guys
on the contrary
it is a very complicated task

wait what!? ...well, I defiantly messed up then (watch, mine probably only works on Tuesdays I bet---every other day it makes toast).

Saturday here
Code: [Select]
Command: (PLINE-ENCLOSURE)
Select objects: Specify opposite corner: 62 found
Select objects:
; error: too few arguments
Title: Re: -={ Challenge }=- Enclose lines
Post by: JohnK on June 30, 2023, 10:51:46 PM
Lol smarta55. Too few arguments!? I’ll have to wait until I get the work laptop fired up again on Monday.
Title: Re: -={ Challenge }=- Enclose lines
Post by: zak26 on June 30, 2023, 11:16:31 PM
Quote from: El Jefe on June 30, 2023, 10:31:27 PM
enl doesn't like this case
I haven't even thought of that case, thanks that'll be something to fix.
Title: Re: -={ Challenge }=- Enclose lines
Post by: VovKa on July 01, 2023, 04:49:13 AM
Quote from: zak26 on June 30, 2023, 05:46:36 PM
I wouldn't think of you saying that
Quote from: zak26 on June 30, 2023, 11:16:31 PM
I haven't even thought of that case
now we are talking :)
Title: Re: -={ Challenge }=- Enclose lines
Post by: VovKa on July 01, 2023, 05:09:48 AM
Quote from: JohnK on June 30, 2023, 09:04:18 PM
wait what!? ...well, I defiantly messed up then (watch, mine probably only works on Tuesdays I bet---every other day it makes toast).
this is the first time i see a program that needs a full week to be tested :)
as for Saturdays - not working

PS
nice disclaimer, though ;)
Quote
  ;; NOTE: I did not implement a sort for these points so if the
  ;;       (poly)lines are not processed "in order" this will
  ;;       draw a wobbly outline.
Title: Re: -={ Challenge }=- Enclose lines
Post by: kasmo on July 01, 2023, 07:54:59 AM
Good enough for the sample dwg, hehe

Code - Auto/Visual Lisp: [Select]
  1. (defun c:outline ( / ss l l2 q p i )
  2.   (setq q (mapcar 'cdr (apply 'append (mapcar '(lambda (y) (vl-remove-if-not '(lambda (x) (member (car x) (list 10 11))) y)) (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget)))))))))
  3.   (setq l2 (cons (setq p (last q)) l2))
  4.   (repeat (length q)
  5.     (setq l nil)
  6.     (repeat (setq i (- (length q) 1))
  7.       (setq l (cons (list (distance p (nth (setq i (1- i)) q)) (nth i q)) l))
  8.     )
  9.     (setq l2 (cons (setq p (cadr (car (vl-sort l '(lambda (x y) (< (car x) (car y))))))) l2))
  10.     (setq q (vl-remove p q))
  11.   )
  12.   (entmake (append (list '(0 . "lwpolyline")) (mapcar '(lambda (x) (cons 10 x)) (setq l2 (vl-remove nil l2))) (list (cons 10 (car l2)))))
  13. )
  14.  
Title: Re: -={ Challenge }=- Enclose lines
Post by: It's Alive! on July 01, 2023, 08:07:12 AM
Quote from: kasmo on July 01, 2023, 07:54:59 AM
Good enough for the sample dwg, hehe

are you sure?  :laugh:

Quote
Command: OUTLINE
Select objects: Specify opposite corner: 61 found
Select objects:
; error: no function definition: REMOVE
Title: Re: -={ Challenge }=- Enclose lines
Post by: kasmo on July 01, 2023, 08:21:28 AM
Quote from: El Jefe on July 01, 2023, 08:07:12 AM
Quote from: kasmo on July 01, 2023, 07:54:59 AM
Good enough for the sample dwg, hehe

are you sure?  :laugh:

Quote
Command: OUTLINE
Select objects: Specify opposite corner: 61 found
Select objects:
; error: no function definition: REMOVE

Not my fault you're using inferior CAD software  :wink:  I changed it now to vl-remove just for you  :-)
Title: Re: -={ Challenge }=- Enclose lines
Post by: JohnK on July 01, 2023, 10:57:39 AM
Quote from: VovKa on July 01, 2023, 05:09:48 AM
this is the first time i see a program that needs a full week to be tested :)
as for Saturdays - not working

Quote from: El Jefe on June 30, 2023, 10:33:52 PM
Saturday here

Okay I fixed my code above (I had a paren misplaced). ...Hopefully I got it fixed so it could be tested on Saturday/Sunday. :)
Title: Re: -={ Challenge }=- Enclose lines
Post by: VovKa on July 01, 2023, 11:38:43 AM
Quote from: JohnK on July 01, 2023, 10:57:39 AM
Okay I fixed my code above (I had a paren misplaced). ...Hopefully I got it fixed so it could be tested on Saturday/Sunday. :)
of course i fixed the misplaced paren myself before testing
https://imgur.com/a/0xKVC0z
Title: Re: -={ Challenge }=- Enclose lines
Post by: zak26 on July 01, 2023, 11:41:43 AM
Quote from: El Jefe on June 30, 2023, 10:31:27 PM
enl doesn't like this case
This didn't happened on my side, could you send me your test file to test it further?

Edit: Not needed, I found an example where it happens, working on it.
Title: Re: -={ Challenge }=- Enclose lines
Post by: JohnK on July 01, 2023, 11:51:51 AM
Quote from: VovKa on July 01, 2023, 11:38:43 AM
Quote from: JohnK on July 01, 2023, 10:57:39 AM
Okay I fixed my code above (I had a paren misplaced). ...Hopefully I got it fixed so it could be tested on Saturday/Sunday. :)
of course i fixed the misplaced paren myself before testing
https://imgur.com/a/0xKVC0z

Ugh! I’ll have to put one of the sort algorithms into my mock-up to handle a window selection. But what happens if you have the items preselected before the program is called (I imagine it wouldn’t make any difference at all)?
Title: Re: -={ Challenge }=- Enclose lines
Post by: VovKa on July 01, 2023, 12:18:04 PM
Quote from: JohnK on July 01, 2023, 11:51:51 AM
But what happens if you have the items preselected before the program is called (I imagine it wouldn’t make any difference at all)?
it does not make any difference
Title: Re: -={ Challenge }=- Enclose lines
Post by: zak26 on July 01, 2023, 02:12:42 PM
Still having this kind of problem, making it recursive did fix the mayor problems but this is still remaining on this kind of shapes (on the dwg)
Title: Re: -={ Challenge }=- Enclose lines
Post by: Lee Mac on July 01, 2023, 05:59:15 PM
Quote from: zak26 on July 01, 2023, 02:12:42 PM
Still having this kind of problem, making it recursive did fix the mayor problems but this is still remaining on this kind of shapes (on the dwg)

Will probably post my code next week - the algorithm isn't particularly clever though.

(http://lee-mac.com/swamp/JoinPoints2.gif)
Title: Re: -={ Challenge }=- Enclose lines
Post by: It's Alive! on July 01, 2023, 11:17:15 PM
another method, make some assumptions  :mrgreen:
Rotate each line seg to align with Y
Sort the line segs by X.
If needed, flip each seg so its kind of codirectional to Y
Build the pline halfs
Rotate it back

Code - Python: [Select]
  1. import PyRx as Rx
  2. import PyGe as Ge
  3. import PyGi as Gi
  4. import PyDb as Db
  5. import PyAp as Ap
  6. import PyEd as Ed
  7. from functools import cmp_to_key
  8.  
  9. def segCmp(segL, segR):
  10.     pl = segL.midPoint()
  11.     pr = segR.midPoint()
  12.     if pl.x < pr.x:
  13.         return -1
  14.     elif pl.x > pr.x:
  15.         return 1
  16.     else:
  17.         return 0
  18.  
  19. def PyRxCmd_pydoit():
  20.     try:
  21.         filter = [(Db.DxfCode.kDxfStart, "LINE,LWPOLYLINE")]
  22.         ssres = Ed.Editor.select(filter)
  23.         if ssres[0] != Ed.PromptStatus.eNormal:
  24.             return
  25.        
  26.         ss = ssres[1].toList()
  27.         dir = None
  28.         segs = []
  29.  
  30.         for id in ss:
  31.             if id.isDerivedFrom(Db.Curve.desc()):
  32.                 curve = Db.Curve(id)
  33.                 segs.append(Ge.LineSeg3d(
  34.                     curve.getStartPoint(), curve.getEndPoint()))
  35.                 if dir == None:
  36.                     dir = curve.getEndPoint() - curve.getStartPoint()
  37.  
  38.         dir.normalize()
  39.         xform = Ge.Matrix3d()
  40.         xform.setToRotation(dir.angleTo(
  41.             Ge.Vector3d.kYAxis, Ge.Vector3d.kZAxis), Ge.Vector3d.kZAxis, Ge.Point3d.kOrigin)
  42.  
  43.         for seg in segs:
  44.             seg.transformBy(xform)
  45.  
  46.         segs.sort(key=cmp_to_key(segCmp))
  47.  
  48.         for seg in segs:
  49.             if seg.getStartPoint().y > seg.getEndPoint().y:
  50.                 seg.reverseParam()
  51.  
  52.         pline = Db.Polyline(len(segs) * 2)
  53.  
  54.         n = 0
  55.         for ind in range(0, len(segs)):
  56.             p = segs[ind].getStartPoint()
  57.             pline.addVertexAt(n, Ge.Point2d(p.x, p.y))
  58.             n += 1
  59.  
  60.         n = len(segs)
  61.         for ind in reversed(range(0, len(segs))):
  62.             p = segs[ind].getEndPoint()
  63.             pline.addVertexAt(n, Ge.Point2d(p.x, p.y))
  64.             n += 1
  65.  
  66.         pline.setClosed(True)
  67.         pline.setColorIndex(1)
  68.         pline.transformBy(xform.invert())
  69.        
  70.         db = Db.HostApplicationServices().workingDatabase()
  71.         model = Db.BlockTableRecord(db.modelSpaceId(), Db.OpenMode.ForWrite)
  72.         model.appendAcDbEntity(pline)
  73.  
  74.     except Exception as err:
  75.         print(err)
  76.  
Title: Re: -={ Challenge }=- Enclose lines
Post by: kasmo on July 02, 2023, 04:16:33 AM
Quote from: zak26 on July 01, 2023, 02:12:42 PM
Still having this kind of problem, making it recursive did fix the mayor problems but this is still remaining on this kind of shapes (on the dwg)
Assuming the lines were drawn in order works well in this case.
Code - Auto/Visual Lisp: [Select]
  1. (defun c:ol ( / l l2 eg )
  2.   (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_:L"))))
  4.     (setq l2 (append l2 (list (vlax-curve-getendpoint x))))
  5.   )
  6.   (entmakex (append (list '(0 . "LWPOLYLINE")
  7.                           '(100 . "AcDbEntity")
  8.                           '(100 . "AcDbPolyline")
  9.                           (cons 90 (+ (length l) (length l2)))
  10.                           '(70 . 1))
  11.                           (mapcar '(lambda (x) (cons 10 x)) (append l (reverse l2))))
  12.   )
  13. )
  14.  
Running multiple functions with different approaches and returning the outline with something like the lowest average vertex length would probably yield the best results.
Title: Re: -={ Challenge }=- Enclose lines
Post by: domenicomaria on July 02, 2023, 03:04:54 PM
Code - Auto/Visual Lisp: [Select]
  1. (defun :LWP-EMK-V-LST   (v-lst)
  2.    (entmake
  3.       (append
  4.             (list   '(0 . "LWPOLYLINE")   '(100 . "AcDbEntity")   '(100 . "AcDbPolyline")   (cons 90 (length v-lst) ) )
  5.             (apply 'append    (mapcar '(lambda (i) (list (cons 10 i ) ) )  v-lst) )
  6.       )
  7.    )
  8. )
  9.  
  10. (defun :SS>OBJECT-LIST (ss / ind l)
  11.    (setq ind 0)
  12.    (repeat (sslength ss)
  13.       (setq l (cons (vlax-ename->vla-object (ssname ss ind) ) l) )      (setq ind (+ 1 ind) )
  14.    )
  15.    (reverse l)
  16. )
  17.  
  18.  
  19. (defun C:PARALLEL-PLINES-SHAPE (
  20.                                    /
  21.                                    -base-ang -base-ang-90 base-ang e-pt i i-pt-0 i-pt-1 o o-e-pt o-s-pt o-x-ang
  22.                                    p0 s-pt sorted-lst sp-ep-xp-lst ss ss-obj-lst v-lst x-ang x-dst x-ep
  23.                                    x-int x-obj x-sp
  24.                                )
  25.    (setvar 'nomutt 1)  (princ "\nnselect  objects :")
  26.    (setq ss (ssget '( (0 . "LWPOLYLINE"))))
  27.    (setvar 'nomutt 0)
  28.  
  29.    (setq ss-obj-lst    (:SS>OBJECT-LIST    ss ) )
  30.    
  31.  
  32.    (setq x-obj       (car ss-obj-lst)
  33.          s-pt        (vlax-curve-getStartPoint x-obj)
  34.          e-pt        (vlax-curve-getEndPoint   x-obj)
  35.          base-ang    (angle s-pt e-pt)
  36.          -base-ang   (angle e-pt s-pt )
  37.          -base-ang-90 (- base-ang (/ pi 2.0) )
  38.          i-pt-0       s-pt
  39.          i-pt-1      (polar i-pt-0 (+ base-ang (/ pi 2.0) ) (distance s-pt e-pt) )
  40.    )
  41.  
  42.    (setq sp-ep-xp-lst
  43.       (mapcar   '(lambda (o)  
  44.                    (setq o-s-pt     (vlax-curve-getStartPoint o)
  45.                         o-e-pt     (vlax-curve-getEndPoint   o)
  46.                         o-x-ang    (angle o-s-pt o-e-pt)
  47.                   )
  48.                   (cond
  49.                      ( (equal o-x-ang  base-ang 1e-6) (list o-s-pt o-e-pt  (inters i-pt-0 i-pt-1 o-s-pt o-e-pt nil) ) )
  50.                      ( (equal o-x-ang -base-ang 1e-6) (list o-e-pt o-s-pt  (inters i-pt-0 i-pt-1 o-s-pt o-e-pt nil) ) )
  51.                      (t (progn (princ "pline is not parallel to the others one !") nil) )
  52.                   )
  53.                )
  54.                ss-obj-lst
  55.       )
  56.    )
  57.  
  58.    (setq sp-ep-xp-lst (vl-remove nil sp-ep-xp-lst) )
  59.  
  60.    
  61.    (setq p0 (caddr (car sp-ep-xp-lst) )  )
  62.    
  63.    (setq sorted-lst   (vl-sort   (mapcar '(lambda (i)
  64.                                           (setq x-sp (car i) x-ep (cadr i) x-int (caddr i)
  65.                                                 x-ang (angle p0 x-int )  x-dst (distance x-int p0)
  66.                                           )
  67.                                           (if(equal x-ang -base-ang-90 1e-6) (setq x-dst (* x-dst -1.0) ) )
  68.                                           (list x-sp x-ep x-dst)
  69.                                        )
  70.                                        sp-ep-xp-lst
  71.                               )
  72.                               '(lambda (j k) (< (caddr j) (caddr k) ) )
  73.                      )
  74.    )
  75.  
  76.    (setq v-lst (append (mapcar 'car sorted-lst)   (reverse (mapcar 'cadr sorted-lst) ) ) )
  77.    (setq v-lst (append v-lst (list (car v-lst) ) ) )
  78.    (setvar "cecolor" "240")
  79.    (:LWP-EMK-V-LST v-lst)
  80. )
  81.  
  82.  
  83. (defun c:PPS () (C:PARALLEL-PLINES-SHAPE) )
  84.    

If PLINES are PARALLEL,
even if they were NOT DRAWN in SEQUENCE
and even if they have OPPOSITE DIRECTIONS,
this one seems to work well !

https://drive.google.com/file/d/19WI-iLc1_uHEaddjnA9NJpXMqYz-tbrk/view?usp=sharing

Title: Re: -={ Challenge }=- Enclose lines
Post by: It's Alive! on July 02, 2023, 06:06:26 PM
Quote from: domenicomaria on July 02, 2023, 03:04:54 PM
...

Well done!
Title: Re: -={ Challenge }=- Enclose lines
Post by: kdub_nz on July 02, 2023, 06:19:18 PM
This may be an edge case :
What happens with a bow-tie shape drawn with non-sequential multi-directional parallel lines with a deep v notch.
A wavy edge where the distance between the ends exceeds twice the line spacing may also fail some algorithms.

Because of the stipulation for parallel lines my intuition would be to make a temporary ucs with X aligled with the collection elements.

Sort the collection bottom to top in Y direction.

Build a points collection by iteration up then down the collection

Build the closed boundary using the points

It would need a bit of translation between ucs <-> world but no complex math.

Regards,
Title: Re: -={ Challenge }=- Enclose lines
Post by: It's Alive! on July 02, 2023, 06:43:10 PM
my last one fails if the lines are greater than 90.
maybe calculate an average
Title: Re: -={ Challenge }=- Enclose lines
Post by: domenicomaria on July 03, 2023, 05:22:55 AM
the first problem is: "what is the problem?"

is this maybe ?

"given a set of lines in the XY plane,
however oriented and of any length,
determine the smallest polygon
containing them"
Title: Re: -={ Challenge }=- Enclose lines
Post by: It's Alive! on July 03, 2023, 08:42:25 AM
Quote from: domenicomaria on July 03, 2023, 05:22:55 AM
the first problem is: "what is the problem?"

is this maybe ?

"given a set of lines in the XY plane,
however oriented and of any length,
determine the smallest polygon
containing them"

I think the original intent was for the lines to be parallel, or with some relaxed tolerance
Title: Re: -={ Challenge }=- Enclose lines
Post by: zak26 on July 03, 2023, 12:16:18 PM
Quote
I think the original intent was for the lines to be parallel, or with some relaxed tolerance
Not quite, What about this?
Title: Re: -={ Challenge }=- Enclose lines
Post by: JohnK on July 03, 2023, 12:37:47 PM
What the? ...I'm out. This "challenge" can't make up its mind.
Title: Re: -={ Challenge }=- Enclose lines
Post by: domenicomaria on July 03, 2023, 12:49:13 PM
... it looks like you want to reconstruct the outline of an exploded hatch

"given a set of lines in the XY plane,
however oriented and of any length,
determine the smallest polygon
containing them"

may be that the answer to this question
might fix it at all ...
Title: Re: -={ Challenge }=- Enclose lines
Post by: ScottMC on July 03, 2023, 01:07:41 PM
just needs get the points 'end' coords of all the entities
and then use "" Gile's or Lee.Mac's "" tools!
It's just putting those two together..

    LM:ConvexHull strange behavior at:

https://www.theswamp.org/index.php?topic=53116.msg578882#msg578882

and Lee.Mac's tool to connect points:
https://www.lee-mac.com/entitytopointlist.html

;;-----------------------------------------------------
  LEFT THE WHILE SELECT LOOP IN IT..

Code: [Select]
;; 
;; Entity to Point List  -  Lee Mac
;; Returns a list of WCS points describing or approximating the supplied entity, else nil if the entity is not supported.
;; ent - [ent] Entity name to be described by point list (POINT/LINE/ARC/CIRCLE/LWPOLYLINE/POLYLINE/ELLIPSE/SPLINE)
;; acc - [num] Positive number determining the point density for non-linear objects

(defun LM:ent->pts ( ent acc / ang bul cen cls di1 di2 enx inc itm lst num ocs rad tot typ vt1 vt2 vtl )
    (setq enx (entget ent)
          typ (cdr (assoc 0 enx))
          acc 4.0   ;; number mods circ,arc point amt
    )
    (cond
        (   (= "POINT" typ)
            (list (cdr (assoc 10 enx)))
        )
        (   (= "LINE" typ)
            (mapcar '(lambda ( x ) (cdr (assoc x enx))) '(10 11))
        )
        (   (or (= "ARC" typ) (= "CIRCLE" typ))
            (if (= "ARC" typ)
                (setq ang (cdr (assoc 50 enx))
                      tot (rem (+ pi pi (- (cdr (assoc 51 enx)) ang)) (+ pi pi))
                      num (fix (+ 1.0 1e-8 (* acc (/ tot (+ pi pi)))))
                      inc (/ tot (float num))
                      num (1+ num)
                )
                (setq ang 0.0
                      tot (+ pi pi)
                      num (fix (+ 1e-8 acc))
                      inc (/ tot (float num))
                )
            )
            (setq cen (cdr (assoc 010 enx))
                  rad (cdr (assoc 040 enx))
                  ocs (cdr (assoc 210 enx))
            )
            (repeat num
                (setq lst (cons (trans (polar cen ang rad) ocs 0) lst)
                      ang (+ ang inc)
                )
            )
            (reverse lst)
        )
        (   (or (= "LWPOLYLINE" typ)
                (and (= "POLYLINE" typ) (zerop (logand (logior 16 64) (cdr (assoc 70 enx)))))
            )
            (if (= "LWPOLYLINE" typ)
                (setq vtl (LM:ent->pts:lwpolyvertices enx))
                (setq vtl (LM:ent->pts:polyvertices   ent))
            )
            (if (setq ocs (cdr (assoc 210 enx))
                      cls (= 1 (logand 1 (cdr (assoc 70 enx))))
                )
                (setq vtl (append vtl (list (cons (caar vtl) 0.0))))
            )
            (while (setq itm (car vtl))
                (setq vtl (cdr vtl)
                      vt1 (car itm)
                      bul (cdr itm)
                      lst (cons (trans vt1 ocs 0) lst)
                )
                (if (and (not (equal 0.0 bul 1e-8)) (setq vt2 (caar vtl)))
                    (progn
                        (setq rad (/ (* (distance vt1 vt2) (1+ (* bul bul))) 4.0 bul)
                              cen (polar vt1 (+ (angle vt1 vt2) (- (/ pi 2.0) (* 2.0 (atan bul)))) rad)
                              rad (abs rad)                           
                              tot (* 4.0 (atan bul))
                              num (fix (+ 1.0 1e-8 (* acc (/ (abs tot) (+ pi pi)))))
                              inc (/ tot (float num))
                              ang (+ (angle cen vt1) inc)
                        )                       
                        (repeat (1- num)
                            (setq lst (cons (trans (polar cen ang rad) ocs 0) lst)
                                  ang (+ ang inc)
                            )
                        )
                    )
                )
            )
            (reverse (if cls (cdr lst) lst))
        )
        (   (= "ELLIPSE" typ)
            (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent))
                  di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam   ent))
                  di2 (- di2 1e-8)
            )
            (while (< di1 di2)
                (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
                      rad (distance '(0.0 0.0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatdist ent di1)))
                      di1 (+ di1 (/ di2 (1+ (fix (* acc (/ di2 rad (+ pi pi)))))))
                )
            )
            (reverse (if (vlax-curve-isclosed ent) lst (cons (vlax-curve-getendpoint ent) lst)))
        )
    )
)

(defun LM:ent->pts:lwpolyvertices ( enx / elv lst vtx )
    (setq elv (list (cdr (assoc 38 enx))))
    (while (setq vtx (assoc 10 enx))
        (setq enx (cdr (member vtx enx))
              lst (cons (cons (append (cdr vtx) elv) (cdr (assoc 42 enx))) lst)
        )
    )
    (reverse lst)
)

(defun LM:ent->pts:polyvertices ( ent / lst vte vtx )
    (setq vte (entnext ent)
          vtx (entget  vte)
    )   
    (while (= "VERTEX" (cdr (assoc 0 vtx)))
        (setq lst (cons (cons (cdr (assoc 10 vtx)) (cdr (assoc 42 vtx))) lst)
              vte (entnext vte)
              vtx (entget  vte)
        )
    )
    (reverse lst)
)
;;// -----------------------------------------------------------------------------------------------------------
   
(defun os3 ( / dist ename vobj )
    (setq dist 0.0000001) ;; puts point close enough to vertex
  ;(setq ent (car (entsel ent))) ;; "\nSelect object to offset: ")
  (setq vobj (vlax-ename->vla-object ent))
  (if (vlax-method-applicable-p vobj 'Offset)
    (progn
     (vlax-invoke vobj 'Offset dist) ; INSIDE
     ;; (vlax-invoke vobj 'Offset (- dist))
    )
    (princ "\nCannot offset selected object type ")
  )
  (princ)
) ;end
;;// -----------------------------------------------------------------------------------------------------------
   
(defun c:p/ ( / *error* ss ent entx dvn ) ;;  ent dvn
(princ "  Places Points On Ends/Arcs/Quads <undo or oops to un-erase..>");;  and Makes Block < *SELECT* >
(setvar 'cmdecho 0)
(setq tot 0)
  (defun *error* ( msg )
    (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
    (if qaf (setvar 'qaflags qaf))
    (if msg (prompt msg))
    (setvar 'cmdecho 1)  ;; (getvar 'cmdecho)
    ;  (setvar "nomutt" 0)  ;; <--works to restore var on pre-finish esc/error..
    (princ)
  )
 
(while
 
   (setq ss (ssget ":S" '((0 . "LINE,ARC,CIRCLE,SPLINE,LWPOLYLINE"))));;filter selection
    (setq ent (ssname ss 0));;grab ename
    (setq dvn 4.0) ;; default
 
        (os3)                   ;;  offset dist: -l 136

   (setq ent (entlast))
  (setq entx ent) ;; make selset with.. to erase
            (command)
              (foreach pnt (LM:ent->pts ent dvn)  ;; 12.0 prefered
              (setq ent (entmake (list '(0 . "POINT") (cons 10 pnt))))
          )
    (setq tot (1+ tot))
   (vl-cmdf "erase" entx "")
   (princ (strcat " Total: " (rtos tot)))
) ;; end of while loop -l 152
(setvar 'cmdecho 1)
;(princ "\n 'O2B' to Make Block<..anonymous>")
  (princ)
)
(vl-load-com) (princ)
Title: Re: -={ Challenge }=- Enclose lines
Post by: JohnK on July 03, 2023, 01:27:25 PM
Quote from: ScottMC on July 03, 2023, 01:07:41 PM
just needs get the points 'end' coords of all the entities
and then use "" Gile's or Lee.Mac's "" tools!
It's just putting those two together..

Doesn't that seem weird (-i.e. how is that fair to Gile or Lee--or anyone else for that matter)? I'm all for using the tools if they save you time but you're just pasting two functions together. What happens if I paste the same functions (written by two different people together); who learns anything from that?

This whole thread seems like it's morphing into a fishing expedition.


Lee,
I just clicked that link mentioned in the post above and it looks like your website is getting a certificate (SSL) error.
Title: Re: -={ Challenge }=- Enclose lines
Post by: domenicomaria on July 03, 2023, 01:37:09 PM
and the polygon could also be concave
Title: Re: -={ Challenge }=- Enclose lines
Post by: ScottMC on July 03, 2023, 01:48:32 PM
"....Cast the net on the other side of the boat."
Title: Re: -={ Challenge }=- Enclose lines
Post by: zak26 on July 03, 2023, 01:57:57 PM
Quote from: domenicomaria on July 03, 2023, 12:49:13 PM
... it looks like you want to reconstruct the outline of an exploded hatch

"given a set of lines in the XY plane,
however oriented and of any length,
determine the smallest polygon
containing them"
The problem started just by joining the endpoints, didn't know where they came from, probably from an exploded hatch, that looks like.

Quote from: JohnK on July 03, 2023, 12:37:47 PM
What the? ...I'm out. This "challenge" can't make up its mind.
It's your right to do so, thanks for your participation

Quote from: JohnK on July 03, 2023, 01:27:25 PM
This whole thread seems like it's morphing into a fishing expedition.
What for?, I think there's no need for those kind of things.
Title: Re: -={ Challenge }=- Enclose lines
Post by: VovKa on July 03, 2023, 03:57:05 PM
Quote from: domenicomaria on July 03, 2023, 01:37:09 PM
and the polygon could also be concave
yep :)
they can have a C-shape or S-shape or even an O-shape

Quote from: VovKa on June 30, 2023, 05:23:29 PM
it is a very complicated task
Title: Re: -={ Challenge }=- Enclose lines
Post by: JohnK on July 03, 2023, 04:22:49 PM
Not sure I follow the net casting remark but I'm a big believer in learning from others code; can you clean up/out some sub-logic from their routines, or do they need to be used as is? And does that spark some alterations you can make to their routine(s)? I can totally see using someone else's function--and I have quite a few in my library from others--but I also modify them to suite my needs if I can. For example, they (Gile or Lee) may have accounted for more conditions than you'd need in this case can you trim/alter the code?

My point was more along the lines of: "Who is to maintain those functions (you or them if their use doesn't give the expected results)?".

I totally understand that some functions are just become "standard" (-i.e. there isn't really a way to streamline because they're so generic or etc.). But some function algorithms play better/faster for certain types of conditions. For a dumb example, there are a TON of "nthremover" functions; it is up to the programmer to know which is better/worse/"the same as" in a given situation.

Code - Auto/Visual Lisp: [Select]
  1. (defun LM:RemoveNth ( n l )
  2.   ;;  Removes the item at the nth index in a supplied list
  3.   ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com
  4.   ;;
  5.   ;;  Arguments:
  6.   ;;  n - index of item to remove (zero based)
  7.   ;;  l - list from which item is to be removed
  8.   ;;
  9.   ;;  Returns:  List with item at index n removed
  10.   (if (and l (< 0 n))
  11.     (cons (car l) (LM:RemoveNth (1- n) (cdr l)))
  12.     (cdr l)
  13.     )
  14.   )
  15.  
  16. (defun LM:RemoveNth ( n l / i )
  17.   ;;  Removes the item at the nth index in a supplied list
  18.   ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com
  19.   ;;
  20.   ;;  Arguments:
  21.   ;;  n - index of item to remove (zero based)
  22.   ;;  l - list from which item is to be removed
  23.   ;;
  24.   ;;  Returns:  List with item at index n removed
  25.   (setq i -1)
  26.   (vl-remove-if '(lambda ( x ) (= (setq i (1+ i)) n)) l)
  27.  )
  28.  
  29.  
  30. (defun cool (lst i / a)
  31.   ;; By: SMadsen
  32.   (setq a -1)
  33.   (vl-remove-if (function (lambda (n)(= (setq a (1+ a)) i))) lst)
  34. )
  35.  
  36. (defun nthRemove (lst i)
  37.   ;; By: SMadsen
  38.   (and (atom i)(setq i (cons (length lst) i)))
  39.   (cond ((null lst) nil)
  40.         ((/= (car i) (cdr i))
  41.          (cons (car lst) (nthRemove (cdr lst) (cons (1- (car i)) (cdr i)))))
  42.         ((cons (car lst) (nthRemove (cddr lst) (cons (1- (car i)) (cdr i)))))
  43.   )
  44. )
  45.  
  46. (defun nthRemover (lst item / nlst cntr)
  47.   ;; By: John Kaul
  48.   (defun Nested-nthRemover (lst item)
  49.     (if (/= (if (not cntr) (setq cntr 0) cntr) item)
  50.       (setq nlst (cons (car lst) nlst)))
  51.     (setq cntr (1+ cntr))
  52.     (if (> (length (cdr lst)) 0)
  53.       (Nested-nthRemover (cdr lst) item)
  54.       (setq cntr nil))
  55.     (reverse nlst))
  56.   (Nested-nthRemover lst item))
Title: Re: -={ Challenge }=- Enclose lines
Post by: JohnK on July 03, 2023, 04:29:03 PM
Quote from: VovKa on July 03, 2023, 03:57:05 PM
Quote from: domenicomaria on July 03, 2023, 01:37:09 PM
and the polygon could also be concave
yep :)
they can have a C-shape or S-shape or even an O-shape

Quote from: VovKa on June 30, 2023, 05:23:29 PM
it is a very complicated task

Yeah, you're not kidding! I started to fix some logic and was starting to put in some sorting stuff into my dumb function and it blew up (after 5 minutes, it was "back to the drawing board" status). ...now, mine doesn't even work on Lbracket-Rbracket-shapes. :)
Title: Re: -={ Challenge }=- Enclose lines
Post by: kdub_nz on July 03, 2023, 05:28:24 PM
Quote from: domenicomaria on July 03, 2023, 05:22:55 AM
the first problem is: "what is the problem?"

is this maybe ?

"given a set of lines in the XY plane,
however oriented and of any length,
determine the smallest polygon
containing them"

Yes, That's the way to ask a question.
A lot of people seem to believe 'we' are mind readers

Sometimes we can't build a cage to hold a rabbit and expect it to hold an elephant , or a snake or a whale as well.

. . . and then there is this :

Title: Re: -={ Challenge }=- Enclose lines
Post by: It's Alive! on July 03, 2023, 07:22:43 PM
my first routine seems to work, my second definitely won't
 
Title: Re: -={ Challenge }=- Enclose lines
Post by: Lee Mac on July 04, 2023, 05:52:46 AM
It is worth noting that, for an arbitrary point list, the problem becomes this -

https://www.theswamp.org/index.php?topic=30434.0
Title: Re: -={ Challenge }=- Enclose lines
Post by: zak26 on July 04, 2023, 12:38:41 PM
Quote from: Lee Mac on July 04, 2023, 05:52:46 AM
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
Title: Re: -={ Challenge }=- Enclose lines
Post by: Lee Mac 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).
Title: Re: -={ Challenge }=- Enclose lines
Post by: zak26 on July 04, 2023, 02:55:01 PM
Quote from: VovKa on June 30, 2023, 05:23:29 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.
Title: Re: -={ Challenge }=- Enclose lines
Post by: kdub_nz 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 ?

Title: Re: -={ Challenge }=- Enclose lines
Post by: zak26 on July 04, 2023, 05:29:49 PM
Quote from: kdub_nz on July 04, 2023, 04:51:17 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

Quote from: kdub_nz on July 04, 2023, 04:51:17 PM
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.
Title: Re: -={ Challenge }=- Enclose lines
Post by: ribarm 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.
Title: Re: -={ Challenge }=- Enclose lines
Post by: ScottMC on July 05, 2023, 10:12:00 PM
Excellant Marco! It does so well.
Title: Re: -={ Challenge }=- Enclose lines
Post by: liuhe 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)
  6.   )
  7.   (SETQ I    0
  8.         LST1 NIL
  9.         E    (SSNAME SS I)
  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)
  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.  
Title: Re: -={ Challenge }=- Enclose lines
Post by: ribarm 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.