Create polyline boundary around points

[J-Rocks]

Hello,

I need to select point objects then create a polyline boundary as in the attached drawing.

Thank you.

[devitg]

erased by devitg

[Sea-Haven]

2 maybes CIV3D has Shrinkwrap command, try Lee-mac.com convex hull program. Neither tested.

[marko_ribar]

You can try TSP-all-2D.lsp posted here :

https://www.theswamp.org/index.php?topic=30434.msg610920#msg610920 

(you have to be logged to download *.lsp file(s)...)

And also there is concave path topic that may be useful :

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/create-border-from-a-set-of-points/m... 

Regards, M.R.

HTH.

[J-Rocks]

The program from the first link takes too long and I had to escape to cancel the command and I have a question here if I may ?

Why all these too much codes into that program ? this might be odd question but I am wondering !

The second program did not work and it come up with incorrect goal, see below snapshot.

Thank you.

[marko_ribar]

TSP stands for NP hard problem... There is no true solution with which we may say - shortest path was founded (for more than 10 points)... To obtain real solution, computer must perform more than 3,000,000 permutations and in the same time do comparison for smaller paths lengths and all that with just 10 points (around - just little less "some paths are the same" for. ex. : pt list = reverse pt list - 10!/2 = 10 factorial / 2 = 10*9*8*7*6*5*4*3*2/2 = ...)... My code and also the similar one posted from author of that topic Evgeniy E. is in fact using visual solution and therefore reducing computational time for reasonable timing in comparison to permutation processing... Still, to acquire something valuable, you must give PC some space to breath and do this job in reasonable time limits giving the fact that we still strive for the shortest solution which we don't know set as a task of random point cloud request... I programmed that code with all my experiences I had and final result was that one version which combines the best of all actors contributing to finding optimal algorithm... So, my suggestion is that you use what you need in reasonable limits either if your job was to focus and get result you visually have as natural way human/person think as acceptable, and automation here is not the most appropriate way to answer to needed outcome - it may help you to some point of view, but rational thinking with your mind capabilities should revise and remedy final solution...

[john.uhden]

@J-Rocks ,

Just wondering...

Might the points have been created in order, first one side then the other?

That would make this project much much simpler.

Or might they be Civil 3D or Land Desktop points with identifiers for left vs. right?

Another idea is to hand draw a polyline roughly following each path.  Then we could connect the dots to each other by their proximity to each hand-drawn polyline.

[J-Rocks]

Thank you.

I think the required solution is to account for each coordinate then remove or ignore the created line that would close the path before processing the entire coordinates.

I have seen something like this on the swamp forum but I can not find a way to search for the right key word to explore it further.

[J-Rocks]

Hi John, and thanks for your inputs.

Actually I can't determine is that the points were created in order so can't rely on this assumption.

Your second suggestion is not possible because I would like to generate the boundary as outside limits of all selected points and without doing anything by hand.

I don't know why I have a feeling is that the program is somehow easy to write but there is something incomplete in my mind to start working on it seriously so that's why I am asking for help here to get a push forward. 

[john.uhden]

@J-Rocks ,

I have another idea...

If you pick the first 2 points (of one side) I think we can determine the next one and so on by comparing the distance and deflection to all the other points.  I also have a method to bulge each segment virtually perfectly without adding any vertices.  Actually, you end up with almost half the vertices vs. points.

[Sea-Haven]

JOHN watch out for ZIG ZAGS if the pattern is a bit more random and not sort of parallel can see find next point doing werid things.

Ok if have CIV3D can make triangles then remove Long triangles, other software has that, then can do even Bpoly to get outside shape.

Like you though will check join points as is.

 I got it to work in a long winded approach, used make triangles TriangV0.6.7, explode triangles, erase using fence  along centre of the 2 outside points so end up with a hole. Hatch hole, then run hatch boundary, erase hatch and other objects etc a lot of work. But doable and reasonably quick once worked out how.

There is some 3d points with z elevation others are at 0.0 so flattened points 1st.

Applying the idea of erase outside triangles could build possibly 3d linework. But very much doubt automated.

[marko_ribar]

@J-Rocks 

Here is another one more recent version that may prove fast and pretty well...

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/challenge-generate-n-closed-plines-f... 

[3wood]

You can try chlh_jd's solution here.

Reply #80.

[marko_ribar]

Here is one more you can try, based on your specific request... Input is little different and well I don't know result is perhaps somewhat OK...

(defun c:pathfind ( / vl-load *error* cmdfun cmderr catch_cont apply_cadr->car ftoa collinear-p chkinters-p chkinters dang car-sort sysvarpreset sysvarlst sysvarvals initvalueslst ti ss sp np i pl an path ocs elev ) ;;; cad, doc, alo, spc - global variables (Visual Lisp main VLA-OBJECT pointers) ;;;

  (defun vl-load nil
    (or cad
      (cond
        ( (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil)))
          (setq cad (vlax-get-acad-object))
        )
        ( t
          (vl-load-com)
          (setq cad (vlax-get-acad-object))
        )
      )
    )
    (or doc (setq doc (vla-get-activedocument cad)))
    (or alo (setq alo (vla-get-activelayout doc)))
    (or spc (setq spc (vla-get-block alo)))
  )

  ;;; sometimes not needed to use/initialize AxiveX Visual Lisp extensions - (comment/uncomment) following line ;;;
  (or (and cad doc alo spc) (vl-load))

  (defun *error* ( m )
    (if (= 8 (logand 8 (getvar (quote undoctl))))
      (if (not (cmdfun (list "_.UNDO" "_E") t))
        (cmderr 23)
        (if doc
          (vla-endundomark doc)
        )
      )
    )
    (if initvalueslst
      (mapcar (function apply_cadr->car) initvalueslst)
    )
    (if doc
      (vla-regen doc acactiveviewport)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun cmdfun ( tokenslist flag ) ;;; tokenslist - command parameters list of strings ;;; flag - if "t" specified, upon successful execution returns t, otherwise if "nil" specified, return is always nil no matter what outcome of function execution is - it should be successful anyway if specified tokenslist was hardcoded correctly... ;;;
    (if command-s
      (if flag
        (if (not (vl-catch-all-error-p (vl-catch-all-apply (function command-s) tokenslist)))
          flag
        )
        (apply (function command-s) tokenslist)
      )
      (if flag
        (apply (function vl-cmdf) tokenslist)
        (apply (function command) tokenslist)
      )
    )
  )

  (defun cmderr ( linenum ) ;;; linenum - integer representing line number at which used (cmdfun) failed with success execution ;;;
    (prompt (strcat "\ncommand execution failure... error at line " (itoa linenum) " ..."))
  )

  (defun catch_cont ( ctch / gr )
    (prompt "\nleft mouse click to continue or enter to generate catch error - ESC to break...")
    (while
      (and
        (vl-catch-all-error-p (or ctch (setq ctch (vl-catch-all-apply (function /) (list 1 0)))))
        (setq gr (grread))
        (/= (car gr) 3)
        (not (equal gr (list 2 13)))
      )
    )
    (if (vl-catch-all-error-p ctch)
      ctch
    )
  )

  (defun apply_cadr->car ( sysvarvaluepair / ctch )
    (setq ctch (vl-catch-all-apply (function setvar) sysvarvaluepair))
    (if (vl-catch-all-error-p ctch)
      (progn
        (prompt (strcat "\ncatched error on setting system variable : " (vl-prin1-to-string (vl-symbol-name (car sysvarvaluepair))) " with value : " (vl-prin1-to-string (cadr sysvarvaluepair))))
        (catch_cont ctch)
      )
    )
  )

  (defun ftoa ( n / m a s b )
    (if (numberp n)
      (progn
        (setq m (fix ((if (< n 0) - +) n 1e-8)))
        (setq a (abs (- n m)))
        (setq m (itoa m))
        (setq s "")
        (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0))))
          (setq s (strcat s (itoa b)))
          (setq a (- (* a 10.0) b))
        )
        (if (= (type n) (quote int))
          m
          (if (= s "")
            m
            (if (and (= m "0") (< n 0))
              (strcat "-" m "." s)
              (strcat m "." s)
            )
          )
        )
      )
    )
  )

  (defun collinear-p ( p1 p p2 )
    (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-6)
  )
 
  (defun chkinters-p ( pl / r )
    (or lil (setq lil (mapcar (function list) pl (append (cdr pl) (list (car pl))))))
    (setq r (vl-some (function (lambda ( x ) (vl-some (function (lambda ( y ) (and (not (equal (car x) (car y) 1e-6)) (not (equal (car x) (cadr y) 1e-6)) (not (equal (cadr x) (car y) 1e-6)) (not (equal (cadr x) (cadr y) 1e-6)) (or (inters (car x) (cadr x) (car y) (cadr y)) (collinear-p (car x) (car y) (cadr x)) (collinear-p (car x) (cadr y) (cadr x)) (collinear-p (car y) (car x) (cadr y)) (collinear-p (car y) (cadr x) (cadr y)))))) (vl-remove (if (= (vl-position x lil) 0) (last lil) (nth (1- (vl-position x lil)) lil)) (vl-remove (if (= (vl-position x lil) (1- (length lil))) (car lil) (nth (1+ (vl-position x lil)) lil)) (vl-remove x lil)))))) lil))
    (setq lil nil)
    r
  )
 
  (defun chkinters ( pl / processlil done r lill ilil iip )
 
    (defun processlil ( ilil lil / pre mid suf ret )
      (setq pre (reverse (cdr (member (car ilil) (reverse lil)))))
      (setq mid (cdr (member (car ilil) lil)))
      (setq mid (cdr (member (cadr ilil) (reverse mid))))
      (setq mid (mapcar (function reverse) mid))
      (setq suf (cdr (member (cadr ilil) lil)))
      (setq ret (append pre (list (list (car (car ilil)) (car (cadr ilil)))) mid (list (list (cadr (car ilil)) (cadr (cadr ilil)))) suf))
      ret
    )
 
    (or lil (setq lil (mapcar (function list) pl (append (cdr pl) (list (car pl))))))
    (while (not done)
      (setq ilil (vl-some (function (lambda ( a ) (vl-some (function (lambda ( b / ip ) (progn (setq iip (inters (car a) (cadr a) (car b) (cadr b))) (if (and (not (equal (cadr a) (car b) 1e-6)) (not (equal (car a) (cadr b) 1e-6)) (not (or (and (collinear-p (car a) (car b) (cadr a)) (collinear-p (car a) (cadr b) (cadr a))) (and (collinear-p (car b) (car a) (cadr b)) (collinear-p (car b) (cadr a) (cadr b))))) (not (or (and (collinear-p (car a) (car b) (cadr a)) (collinear-p (car b) (cadr a) (cadr b))) (and (collinear-p (car b) (car a) (cadr b)) (collinear-p (car a) (cadr b) (cadr a)))))) (cond ( (collinear-p (car a) (car b) (cadr a)) (setq ip (car b)) ) ( (collinear-p (car a) (cadr b) (cadr a)) (setq ip (cadr b)) ) ( (collinear-p (car b) (car a) (cadr b)) (setq ip (car a)) ) ( (collinear-p (car b) (cadr a) (cadr b)) (setq ip (cadr a)) )) (setq iip nil)) (cond ( iip (list a b iip) ) ( ip (list a b ip) ))))) (vl-remove a lil)))) lil))
      (cond
        ( (and ilil (equal iip (caddr ilil) 1e-6))
          (setq lil (processlil ilil lil))
        )
        ( (and ilil (equal (caar ilil) (caddr ilil) 1e-6))
          (cond
            ( (and (not (equal (caar ilil) (caadr ilil) 1e-6)) (not (equal (caar ilil) (cadadr ilil) 1e-6)))
              (setq lil (processlil ilil lil))
            )
            ( (equal (caar ilil) (caadr ilil) 1e-6)
              (setq lil (processlil ilil lil))
            )
            ( (equal (caar ilil) (cadadr ilil) 1e-6)
              (setq ilil (subst (assoc (cadadr ilil) lil) (cadr ilil) ilil))
              (setq lil (processlil ilil lil))
            )
          )
        )
        ( (and ilil (equal (cadar ilil) (caddr ilil) 1e-6))
          (cond
            ( (and (not (equal (cadar ilil) (caadr ilil) 1e-6)) (not (equal (cadar ilil) (cadadr ilil) 1e-6)))
              (setq ilil (subst (assoc (cadar ilil) lil) (car ilil) ilil))
              (setq lil (processlil ilil lil))
            )
            ( (equal (cadar ilil) (caadr ilil) 1e-6)
              (setq ilil (subst (assoc (cadar ilil) lil) (car ilil) ilil))
              (setq lil (processlil ilil lil))
            )
            ( (equal (cadar ilil) (cadadr ilil) 1e-6)
              (setq ilil (subst (assoc (cadar ilil) lil) (car ilil) ilil))
              (setq ilil (subst (assoc (cadadr ilil) lil) (cadr ilil) ilil))
              (setq lil (processlil ilil lil))
            )
          )
        )
        ( (and ilil (equal (caadr ilil) (caddr ilil) 1e-6))
          (cond
            ( (and (not (equal (caadr ilil) (caar ilil) 1e-6)) (not (equal (caadr ilil) (cadar ilil) 1e-6)))
              (setq lil (processlil ilil lil))
            )
            ( (equal (caadr ilil) (caar ilil) 1e-6)
              (setq lil (processlil ilil lil))
            )
            ( (equal (caadr ilil) (cadar ilil) 1e-6)
              (setq ilil (subst (assoc (caadr ilil) lil) (car ilil) ilil))
              (setq lil (processlil ilil lil))
            )
          )
        )
        ( (and ilil (equal (cadadr ilil) (caddr ilil) 1e-6))
          (cond
            ( (and (not (equal (cadadr ilil) (caar ilil) 1e-6)) (not (equal (cadadr ilil) (cadar ilil) 1e-6)))
              (setq ilil (subst (assoc (cadadr ilil) lil) (cadr ilil) ilil))
              (setq lil (processlil ilil lil))
            )
            ( (equal (cadadr ilil) (caar ilil) 1e-6)
              (setq ilil (subst (assoc (cadadr ilil) lil) (cadr ilil) ilil))
              (setq lil (processlil ilil lil))
            )
            ( (equal (cadadr ilil) (cadar ilil) 1e-6)
              (setq ilil (subst (assoc (cadadr ilil) lil) (cadr ilil) ilil))
              (setq ilil (subst (assoc (cadar ilil) lil) (car ilil) ilil))
              (setq lil (processlil ilil lil))
            )
          )
        )
        ( t (setq done t) )
      )
    )
    (setq r (mapcar (function car) lil))
    (setq lil nil)
    r
  )

  (defun dang ( p1 p2 a / an da )
    (setq an (angle p1 p2))
    (setq da (min (abs (- an a)) (abs (- an (+ a (* 2 pi)))) (abs (- (+ an (* 2 pi)) a))))
  )

  (defun car-sort ( lst cmp / rtn )
    (setq rtn (car lst))
    (foreach itm (cdr lst)
      (if (apply cmp (list itm rtn))
        (setq rtn itm)
      )
    )
    rtn
  )

  (setq sysvarpreset
    (list
      (list (quote cmdecho) 0)
      (list (quote 3dosmode) 0)
      (list (quote osmode) 0)
      (list (quote unitmode) 0)
      (list (quote cmddia) 0)
      (list (quote ucsvp) 0)
      (list (quote ucsortho) 0)
      (list (quote projmode) 0)
      (list (quote orbitautotarget) 0)
      (list (quote insunits) 0)
      (list (quote hpseparate) 0)
      (list (quote hpgaptol) 0)
      (list (quote halogap) 0)
      (list (quote edgemode) 0)
      (list (quote pickdrag) 0)
      (list (quote qtextmode) 0)
      (list (quote dragsnap) 0)
      (list (quote angdir) 0)
      (list (quote aunits) 0)
      (list (quote limcheck) 0)
      (list (quote gridmode) 0)
      (list (quote nomutt) 0)
      (list (quote apbox) 0)
      (list (quote attdia) 0)
      (list (quote blipmode) 0)
      (list (quote copymode) 0)
      (list (quote circlerad) 0.0)
      (list (quote filletrad) 0.0)
      (list (quote filedia) 1)
      (list (quote autosnap) 1)
      (list (quote objectisolationmode) 1)
      (list (quote highlight) 1)
      (list (quote lispinit) 1)
      (list (quote layerpmode) 1)
      (list (quote fillmode) 1)
      (list (quote dragmodeinterrupt) 1)
      (list (quote dispsilh) 1)
      (list (quote fielddisplay) 1)
      (list (quote deletetool) 1)
      (list (quote delobj) 1)
      (list (quote dblclkedit) 1)
      (list (quote attreq) 1)
      (list (quote explmode) 1)
      (list (quote frameselection) 1)
      (list (quote ltgapselection) 1)
      (list (quote pickfirst) 1)
      (list (quote plinegen) 1)
      (list (quote plinetype) 1)
      (list (quote peditaccept) 1)
      (list (quote solidcheck) 1)
      (list (quote visretain) 1)
      (list (quote regenmode) 1)
      (list (quote celtscale) 1.0)
      (list (quote ltscale) 1.0)
      (list (quote osnapcoord) 2)
      (list (quote grips) 2)
      (list (quote dragmode) 2)
      (list (quote lunits) 2)
      (list (quote pickstyle) 3)
      (list (quote navvcubedisplay) 3)
      (list (quote pickauto) 3)
      (list (quote draworderctl) 3)
      (list (quote expert) 5)
      (list (quote auprec) 6)
      (list (quote luprec) 6)
      (list (quote pickbox) 6)
      (list (quote aperture) 6)
      (list (quote osoptions) 7)
      (list (quote dimzin) 8)
      (list (quote pdmode) 35)
      (list (quote pdsize) -1.5)
      (list (quote celweight) -1)
      (list (quote cecolor) "BYLAYER")
      (list (quote celtype) "ByLayer")
      (list (quote clayer) "0")
    )
  )
  (setq sysvarlst (mapcar (function car) sysvarpreset))
  (setq sysvarvals (mapcar (function cadr) sysvarpreset))
  (setq sysvarvals
    (vl-remove nil
      (mapcar
        (function (lambda ( x )
          (if (getvar x) (nth (vl-position x sysvarlst) sysvarvals))
        ))
        sysvarlst
      )
    )
  )
  (setq sysvarlst
    (vl-remove-if-not
      (function (lambda ( x )
        (getvar x)
      ))
      sysvarlst
    )
  )
  (setq initvalueslst
    (apply (function mapcar)
      (cons (function list)
        (list
          sysvarlst
          (mapcar (function getvar) sysvarlst)
        )
      )
    )
  )
  (apply (function mapcar)
    (cons (function setvar)
      (list
        sysvarlst
        sysvarvals
      )
    )
  )
  (if (= 8 (logand 8 (getvar (quote undoctl))))
    (if (not (cmdfun (list "_.UNDO" "_E") t))
      (cmderr 344)
      (if doc
        (vla-endundomark doc)
      )
    )
  )
  (if (not (cmdfun (list "_.UNDO" "_M") t))
    (cmderr 351)
    (if doc
      (vla-startundomark doc)
    )
  )
  (setvar (quote osmode) 8)
  (prompt "\nSelect points, blocks or circles...")
  (if
    (and
      (setq ss (ssget (list (cons 0 "POINT,INSERT,CIRCLE"))))
      (setq sp (trans (getpoint "\nPick or specify starting point : ") 1 0))
      (setq np (trans (getpoint sp "\nPick or specify next following point from which to look further approximate connection based on vector angle : ") 1 0))
    )
    (progn
      (setq ti (car (_vl-times)))
      (setvar (quote osmode) 0)
      (repeat (setq i (sslength ss))
        (setq pl (cons (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))) pl))
      )
      (setq an (angle sp np))
      (setq path (cons sp path))
      (while (setq pl (vl-remove-if (function (lambda ( x ) (equal x sp 1e-6))) pl))
        (setq sp (car-sort pl (function (lambda ( a b ) (< (dang sp a an) (dang sp b an))))))
        (setq path (cons sp path))
        (setq an (angle (cadr path) (car path)))
      )
      (setq ocs (trans (list 0.0 0.0 1.0) 1 0 t))
      (setq elev (caddr (trans (list 0.0 0.0 0.0) 1 ocs)))
      (setq path
        (mapcar
          (function (lambda ( x )
            (mapcar (function +)
              (list 0.0 0.0)
              (trans x 0 ocs)
            )
          ))
          path
        )
      )
      (if (chkinters-p path)
        (setq path (chkinters path))
      )
      (entmake
        (append
          (list
            (cons 0 "LWPOLYLINE")
            (cons 100 "AcDbEntity")
            (cons 100 "AcDbPolyline")
            (cons 90 (length path))
            (cons 70 (1+ (* 128 (getvar (quote plinegen)))))
            (cons 38 elev)
          )
          (mapcar (function (lambda ( x ) (cons 10 x))) path)
          (list (cons 210 ocs))
        )
      )
      (setq d (vlax-curve-getdistatparam (entlast) (vlax-curve-getendparam (entlast))))
      (prompt "\nLWPOLYLINE length : ") (prompt (ftoa d))
      (prompt "\nElapsed time : ") (prompt (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...")
      (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...")
    )
  )
  (*error* nil)
)

[J-Rocks]

Hi,

It does not work the correct way, here is the result on long path.

[J-Rocks]

Thanks,

I already thought is that the same thread might help but I did not know which program posted there would help.

Can you refer to the program that would help with my case please ?

[marko_ribar]

---

@J-Rocks wrote:

Thanks,

I already thought is that the same thread might help but I did not know which program posted there would help.

Can you refer to the program that would help with my case please ?

---

Ether use last posted *.lsp (TSP-all-2D.lsp), or read again this comment and be satisfied...

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/create-polyline-boundary-around-poin... 

[J-Rocks]

Hi John,

I am eager to see and try your codes if you have time to write any that would help ?

[3wood]

It in Post #80.

Just copy the code and run it. I've tested and it got the result you want.

[marko_ribar]

Also got correct result based on my lastly posted code... Here is revision :

(defun c:pathfind ( / vl-load *error* cmdfun cmderr catch_cont apply_cadr->car ftoa collinear-p chkinters-p chkinters dang car-sort sysvarpreset sysvarlst sysvarvals initvalueslst ti ss sp np fuzz i pl an path ocs elev ) ;;; cad, doc, alo, spc - global variables (Visual Lisp main VLA-OBJECT pointers) ;;;

  (defun vl-load nil
    (or cad
      (cond
        ( (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil)))
          (setq cad (vlax-get-acad-object))
        )
        ( t
          (vl-load-com)
          (setq cad (vlax-get-acad-object))
        )
      )
    )
    (or doc (setq doc (vla-get-activedocument cad)))
    (or alo (setq alo (vla-get-activelayout doc)))
    (or spc (setq spc (vla-get-block alo)))
  )

  ;;; sometimes not needed to use/initialize AxiveX Visual Lisp extensions - (comment/uncomment) following line ;;;
  (or (and cad doc alo spc) (vl-load))

  (defun *error* ( m )
    (if (= 8 (logand 8 (getvar (quote undoctl))))
      (if (not (cmdfun (list "_.UNDO" "_E") t))
        (cmderr 23)
        (if doc
          (vla-endundomark doc)
        )
      )
    )
    (if initvalueslst
      (mapcar (function apply_cadr->car) initvalueslst)
    )
    (if doc
      (vla-regen doc acactiveviewport)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun cmdfun ( tokenslist flag ) ;;; tokenslist - command parameters list of strings ;;; flag - if "t" specified, upon successful execution returns t, otherwise if "nil" specified, return is always nil no matter what outcome of function execution is - it should be successful anyway if specified tokenslist was hardcoded correctly... ;;;
    (if command-s
      (if flag
        (if (not (vl-catch-all-error-p (vl-catch-all-apply (function command-s) tokenslist)))
          flag
        )
        (apply (function command-s) tokenslist)
      )
      (if flag
        (apply (function vl-cmdf) tokenslist)
        (apply (function command) tokenslist)
      )
    )
  )

  (defun cmderr ( linenum ) ;;; linenum - integer representing line number at which used (cmdfun) failed with success execution ;;;
    (prompt (strcat "\ncommand execution failure... error at line " (itoa linenum) " ..."))
  )

  (defun catch_cont ( ctch / gr )
    (prompt "\nleft mouse click to continue or enter to generate catch error - ESC to break...")
    (while
      (and
        (vl-catch-all-error-p (or ctch (setq ctch (vl-catch-all-apply (function /) (list 1 0)))))
        (setq gr (grread))
        (/= (car gr) 3)
        (not (equal gr (list 2 13)))
      )
    )
    (if (vl-catch-all-error-p ctch)
      ctch
    )
  )

  (defun apply_cadr->car ( sysvarvaluepair / ctch )
    (setq ctch (vl-catch-all-apply (function setvar) sysvarvaluepair))
    (if (vl-catch-all-error-p ctch)
      (progn
        (prompt (strcat "\ncatched error on setting system variable : " (vl-prin1-to-string (vl-symbol-name (car sysvarvaluepair))) " with value : " (vl-prin1-to-string (cadr sysvarvaluepair))))
        (catch_cont ctch)
      )
    )
  )

  (defun ftoa ( n / m a s b )
    (if (numberp n)
      (progn
        (setq m (fix ((if (< n 0) - +) n 1e-8)))
        (setq a (abs (- n m)))
        (setq m (itoa m))
        (setq s "")
        (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0))))
          (setq s (strcat s (itoa b)))
          (setq a (- (* a 10.0) b))
        )
        (if (= (type n) (quote int))
          m
          (if (= s "")
            m
            (if (and (= m "0") (< n 0))
              (strcat "-" m "." s)
              (strcat m "." s)
            )
          )
        )
      )
    )
  )

  (defun collinear-p ( p1 p p2 )
    (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-6)
  )
 
  (defun chkinters-p ( pl / r )
    (or lil (setq lil (mapcar (function list) pl (append (cdr pl) (list (car pl))))))
    (setq r (vl-some (function (lambda ( x ) (vl-some (function (lambda ( y ) (and (not (equal (car x) (car y) 1e-6)) (not (equal (car x) (cadr y) 1e-6)) (not (equal (cadr x) (car y) 1e-6)) (not (equal (cadr x) (cadr y) 1e-6)) (or (inters (car x) (cadr x) (car y) (cadr y)) (collinear-p (car x) (car y) (cadr x)) (collinear-p (car x) (cadr y) (cadr x)) (collinear-p (car y) (car x) (cadr y)) (collinear-p (car y) (cadr x) (cadr y)))))) (vl-remove (if (= (vl-position x lil) 0) (last lil) (nth (1- (vl-position x lil)) lil)) (vl-remove (if (= (vl-position x lil) (1- (length lil))) (car lil) (nth (1+ (vl-position x lil)) lil)) (vl-remove x lil)))))) lil))
    (setq lil nil)
    r
  )
 
  (defun chkinters ( pl / processlil done r lill ilil iip )
 
    (defun processlil ( ilil lil / pre mid suf ret )
      (setq pre (reverse (cdr (member (car ilil) (reverse lil)))))
      (setq mid (cdr (member (car ilil) lil)))
      (setq mid (cdr (member (cadr ilil) (reverse mid))))
      (setq mid (mapcar (function reverse) mid))
      (setq suf (cdr (member (cadr ilil) lil)))
      (setq ret (append pre (list (list (car (car ilil)) (car (cadr ilil)))) mid (list (list (cadr (car ilil)) (cadr (cadr ilil)))) suf))
      ret
    )
 
    (or lil (setq lil (mapcar (function list) pl (append (cdr pl) (list (car pl))))))
    (while (not done)
      (setq ilil (vl-some (function (lambda ( a ) (vl-some (function (lambda ( b / ip ) (progn (setq iip (inters (car a) (cadr a) (car b) (cadr b))) (if (and (not (equal (cadr a) (car b) 1e-6)) (not (equal (car a) (cadr b) 1e-6)) (not (or (and (collinear-p (car a) (car b) (cadr a)) (collinear-p (car a) (cadr b) (cadr a))) (and (collinear-p (car b) (car a) (cadr b)) (collinear-p (car b) (cadr a) (cadr b))))) (not (or (and (collinear-p (car a) (car b) (cadr a)) (collinear-p (car b) (cadr a) (cadr b))) (and (collinear-p (car b) (car a) (cadr b)) (collinear-p (car a) (cadr b) (cadr a)))))) (cond ( (collinear-p (car a) (car b) (cadr a)) (setq ip (car b)) ) ( (collinear-p (car a) (cadr b) (cadr a)) (setq ip (cadr b)) ) ( (collinear-p (car b) (car a) (cadr b)) (setq ip (car a)) ) ( (collinear-p (car b) (cadr a) (cadr b)) (setq ip (cadr a)) )) (setq iip nil)) (cond ( iip (list a b iip) ) ( ip (list a b ip) ))))) (vl-remove a lil)))) lil))
      (cond
        ( (and ilil (equal iip (caddr ilil) 1e-6))
          (setq lil (processlil ilil lil))
        )
        ( (and ilil (equal (caar ilil) (caddr ilil) 1e-6))
          (cond
            ( (and (not (equal (caar ilil) (caadr ilil) 1e-6)) (not (equal (caar ilil) (cadadr ilil) 1e-6)))
              (setq lil (processlil ilil lil))
            )
            ( (equal (caar ilil) (caadr ilil) 1e-6)
              (setq lil (processlil ilil lil))
            )
            ( (equal (caar ilil) (cadadr ilil) 1e-6)
              (setq ilil (subst (assoc (cadadr ilil) lil) (cadr ilil) ilil))
              (setq lil (processlil ilil lil))
            )
          )
        )
        ( (and ilil (equal (cadar ilil) (caddr ilil) 1e-6))
          (cond
            ( (and (not (equal (cadar ilil) (caadr ilil) 1e-6)) (not (equal (cadar ilil) (cadadr ilil) 1e-6)))
              (setq ilil (subst (assoc (cadar ilil) lil) (car ilil) ilil))
              (setq lil (processlil ilil lil))
            )
            ( (equal (cadar ilil) (caadr ilil) 1e-6)
              (setq ilil (subst (assoc (cadar ilil) lil) (car ilil) ilil))
              (setq lil (processlil ilil lil))
            )
            ( (equal (cadar ilil) (cadadr ilil) 1e-6)
              (setq ilil (subst (assoc (cadar ilil) lil) (car ilil) ilil))
              (setq ilil (subst (assoc (cadadr ilil) lil) (cadr ilil) ilil))
              (setq lil (processlil ilil lil))
            )
          )
        )
        ( (and ilil (equal (caadr ilil) (caddr ilil) 1e-6))
          (cond
            ( (and (not (equal (caadr ilil) (caar ilil) 1e-6)) (not (equal (caadr ilil) (cadar ilil) 1e-6)))
              (setq lil (processlil ilil lil))
            )
            ( (equal (caadr ilil) (caar ilil) 1e-6)
              (setq lil (processlil ilil lil))
            )
            ( (equal (caadr ilil) (cadar ilil) 1e-6)
              (setq ilil (subst (assoc (caadr ilil) lil) (car ilil) ilil))
              (setq lil (processlil ilil lil))
            )
          )
        )
        ( (and ilil (equal (cadadr ilil) (caddr ilil) 1e-6))
          (cond
            ( (and (not (equal (cadadr ilil) (caar ilil) 1e-6)) (not (equal (cadadr ilil) (cadar ilil) 1e-6)))
              (setq ilil (subst (assoc (cadadr ilil) lil) (cadr ilil) ilil))
              (setq lil (processlil ilil lil))
            )
            ( (equal (cadadr ilil) (caar ilil) 1e-6)
              (setq ilil (subst (assoc (cadadr ilil) lil) (cadr ilil) ilil))
              (setq lil (processlil ilil lil))
            )
            ( (equal (cadadr ilil) (cadar ilil) 1e-6)
              (setq ilil (subst (assoc (cadadr ilil) lil) (cadr ilil) ilil))
              (setq ilil (subst (assoc (cadar ilil) lil) (car ilil) ilil))
              (setq lil (processlil ilil lil))
            )
          )
        )
        ( t (setq done t) )
      )
    )
    (setq r (mapcar (function car) lil))
    (setq lil nil)
    r
  )

  (defun dang ( p1 p2 a / an da )
    (setq an (angle p1 p2))
    (setq da (min (abs (- an a)) (abs (- an (+ a (* 2 pi)))) (abs (- (+ an (* 2 pi)) a))))
  )

  (defun car-sort ( lst cmp / rtn )
    (setq rtn (car lst))
    (foreach itm (cdr lst)
      (if (apply cmp (list itm rtn))
        (setq rtn itm)
      )
    )
    rtn
  )

  (setq sysvarpreset
    (list
      (list (quote cmdecho) 0)
      (list (quote 3dosmode) 0)
      (list (quote osmode) 0)
      (list (quote unitmode) 0)
      (list (quote cmddia) 0)
      (list (quote ucsvp) 0)
      (list (quote ucsortho) 0)
      (list (quote projmode) 0)
      (list (quote orbitautotarget) 0)
      (list (quote insunits) 0)
      (list (quote hpseparate) 0)
      (list (quote hpgaptol) 0)
      (list (quote halogap) 0)
      (list (quote edgemode) 0)
      (list (quote pickdrag) 0)
      (list (quote qtextmode) 0)
      (list (quote dragsnap) 0)
      (list (quote angdir) 0)
      (list (quote aunits) 0)
      (list (quote limcheck) 0)
      (list (quote gridmode) 0)
      (list (quote nomutt) 0)
      (list (quote apbox) 0)
      (list (quote attdia) 0)
      (list (quote blipmode) 0)
      (list (quote copymode) 0)
      (list (quote circlerad) 0.0)
      (list (quote filletrad) 0.0)
      (list (quote filedia) 1)
      (list (quote autosnap) 1)
      (list (quote objectisolationmode) 1)
      (list (quote highlight) 1)
      (list (quote lispinit) 1)
      (list (quote layerpmode) 1)
      (list (quote fillmode) 1)
      (list (quote dragmodeinterrupt) 1)
      (list (quote dispsilh) 1)
      (list (quote fielddisplay) 1)
      (list (quote deletetool) 1)
      (list (quote delobj) 1)
      (list (quote dblclkedit) 1)
      (list (quote attreq) 1)
      (list (quote explmode) 1)
      (list (quote frameselection) 1)
      (list (quote ltgapselection) 1)
      (list (quote pickfirst) 1)
      (list (quote plinegen) 1)
      (list (quote plinetype) 1)
      (list (quote peditaccept) 1)
      (list (quote solidcheck) 1)
      (list (quote visretain) 1)
      (list (quote regenmode) 1)
      (list (quote celtscale) 1.0)
      (list (quote ltscale) 1.0)
      (list (quote osnapcoord) 2)
      (list (quote grips) 2)
      (list (quote dragmode) 2)
      (list (quote lunits) 2)
      (list (quote pickstyle) 3)
      (list (quote navvcubedisplay) 3)
      (list (quote pickauto) 3)
      (list (quote draworderctl) 3)
      (list (quote expert) 5)
      (list (quote auprec) 6)
      (list (quote luprec) 6)
      (list (quote pickbox) 6)
      (list (quote aperture) 6)
      (list (quote osoptions) 7)
      (list (quote dimzin) 8)
      (list (quote pdmode) 35)
      (list (quote pdsize) -1.5)
      (list (quote celweight) -1)
      (list (quote cecolor) "BYLAYER")
      (list (quote celtype) "ByLayer")
      (list (quote clayer) "0")
    )
  )
  (setq sysvarlst (mapcar (function car) sysvarpreset))
  (setq sysvarvals (mapcar (function cadr) sysvarpreset))
  (setq sysvarvals
    (vl-remove nil
      (mapcar
        (function (lambda ( x )
          (if (getvar x) (nth (vl-position x sysvarlst) sysvarvals))
        ))
        sysvarlst
      )
    )
  )
  (setq sysvarlst
    (vl-remove-if-not
      (function (lambda ( x )
        (getvar x)
      ))
      sysvarlst
    )
  )
  (setq initvalueslst
    (apply (function mapcar)
      (cons (function list)
        (list
          sysvarlst
          (mapcar (function getvar) sysvarlst)
        )
      )
    )
  )
  (apply (function mapcar)
    (cons (function setvar)
      (list
        sysvarlst
        sysvarvals
      )
    )
  )
  (if (= 8 (logand 8 (getvar (quote undoctl))))
    (if (not (cmdfun (list "_.UNDO" "_E") t))
      (cmderr 344)
      (if doc
        (vla-endundomark doc)
      )
    )
  )
  (if (not (cmdfun (list "_.UNDO" "_M") t))
    (cmderr 351)
    (if doc
      (vla-startundomark doc)
    )
  )
  (setvar (quote osmode) 8)
  (prompt "\nSelect points, blocks or circles...")
  (if
    (and
      (setq ss (ssget (list (cons 0 "POINT,INSERT,CIRCLE"))))
      (setq sp (trans (getpoint "\nPick or specify starting point : ") 1 0))
      (setq np (trans (getpoint (trans sp 0 1) "\nPick or specify next following point from which to look further approximate connection based on vector angle : ") 1 0))
      (progn
        (setq fuzz 1.0)
        (while (<= fuzz 1.0)
          (initget 6)
          (setq fuzz (cond ( (getreal "\nSpecify fuzz multiplication factor for closest next distance proximity radius of circular area reducing search for next point candidates - must be greater than 1.0 (only closest point no matter of reference vector angle) - <3.0> : ") ) (3.0) ))
        )
        fuzz
      )
    )
    (progn
      (setq ti (car (_vl-times)))
      (setvar (quote osmode) 0)
      (repeat (setq i (sslength ss))
        (setq pl
          (cons
            (cdr
              (assoc 10
                (entget
                  (ssname ss
                    (setq i (1- i))
                  )
                )
              )
            )
            pl
          )
        )
      )
      (setq an (angle (trans sp 0 1) (trans np 0 1)))
      (setq path (cons sp path))
      (while
        (setq pl
          (vl-remove-if
            (function (lambda ( x )
              (equal x sp 1e-6)
            ))
            pl
          )
        )
        (setq sp
          (car-sort
            (vl-remove-if
              (function (lambda ( x )
                (>
                  (distance
                    (mapcar (function +)
                      (list 0.0 0.0)
                      (trans sp 0 1)
                    )
                    (trans x 0 1)
                  )
                  (* fuzz
                    (distance
                      (mapcar (function +)
                        (list 0.0 0.0)
                        (trans sp 0 1)
                      )
                      (car-sort pl
                        (function (lambda ( a b )
                          (<
                            (distance
                              (mapcar (function +)
                                (list 0.0 0.0)
                                (trans sp 0 1)
                              )
                              (trans a 0 1)
                            )
                            (distance
                              (mapcar (function +)
                                (list 0.0 0.0)
                                (trans sp 0 1)
                              )
                              (trans b 0 1)
                            )
                          )
                        ))
                      )
                    )
                  )
                )
              ))
              pl
            )
            (function (lambda ( a b )
              (<
                (*
                  (distance
                    (mapcar (function +)
                      (list 0.0 0.0)
                      (trans sp 0 1)
                    )
                    (trans a 0 1)
                  )
                  (dang (trans sp 0 1) (trans a 0 1) an)
                )
                (*
                  (distance
                    (mapcar (function +)
                      (list 0.0 0.0)
                      (trans sp 0 1)
                    )
                    (trans b 0 1)
                  )
                  (dang (trans sp 0 1) (trans b 0 1) an)
                )
              )
            ))
          )
        )
        (setq path (cons sp path))
        (setq an (angle (trans (cadr path) 0 1) (trans (car path) 0 1)))
      )
      (setq ocs (trans (list 0.0 0.0 1.0) 1 0 t))
      (setq elev (caddr (trans (list 0.0 0.0 0.0) 1 ocs)))
      (setq path
        (mapcar
          (function (lambda ( x )
            (mapcar (function +)
              (list 0.0 0.0)
              (trans x 0 ocs)
            )
          ))
          path
        )
      )
      (if (chkinters-p path)
        (setq path (chkinters path))
      )
      (entmake
        (append
          (list
            (cons 0 "LWPOLYLINE")
            (cons 100 "AcDbEntity")
            (cons 100 "AcDbPolyline")
            (cons 90 (length path))
            (cons 70 (1+ (* 128 (getvar (quote plinegen)))))
            (cons 38 elev)
          )
          (mapcar (function (lambda ( x ) (cons 10 x))) path)
          (list (cons 210 ocs))
        )
      )
      (setq d (vlax-curve-getdistatparam (entlast) (vlax-curve-getendparam (entlast))))
      (prompt "\nLWPOLYLINE length : ") (prompt (ftoa d))
      (prompt "\nElapsed time : ") (prompt (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...")
      (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...")
    )
  )
  (*error* nil)
)

HTH., M.R.