Leaderboard

Not sure if OP is still online, but IMHO, I think this update is better... (defun c:lw_orth ( / un f p lw lwx pl cl ) (defun un ( l / a ll ) (while (setq a (car l)) (if (vl-some (function (lambda ( x ) (equal x a 1e-10))) l) (setq ll (cons a ll) l (vl-remove-if (function (lambda ( x ) (equal x a 1e-10))) (cdr l))) (setq ll (cons a ll) l (cdr l)) ) ) (reverse ll) ) (defun f ( l / i p1 p2 px r ) (if (> (length l) 2) (progn (setq i -1) (while (< (setq i (1+ i)) (1- (length l))) (if (not p1) (setq p1 (nth i l) p2 (nth (1+ i) l)) (setq p1 p2 p2 (nth (1+ i) l)) ) (if (= i 0) (setq r (cons (car l) r)) ) (setq r (cons (if (setq px (p p1 p2 p2)) (setq p2 px) p2) r)) (if (= i (- (length l) 2)) (setq r (cons (last l) r)) ) ) (setq r (reverse r)) (un (apply (function append) (mapcar (function (lambda ( p1 p2 / pp ) (if (setq pp (vl-some (function (lambda ( x ) (if (and (equal (distance p1 p2) (+ (distance p1 x) (distance x p2)) 1e-10) (not (equal x p1 1e-10)) (not (equal x p2 1e-10))) x))) l)) (list p1 pp) (list p1)))) r (append (cdr r) (list (car r)))))) ) ) ) (defun p ( p1 p2 p3 / p21 p22 ) (setq p21 (inters p1 (polar p1 (* 0.5 pi) 1.0) p3 (polar p3 0.0 1.0) nil)) (setq p22 (inters p1 (polar p1 0.0 1.0) p3 (polar p3 (* 0.5 pi) 1.0) nil)) (if (< (distance p2 p21) (distance p2 p22)) p21 p22 ) ) (if (and (setq lw (car (entsel "\nPick polygonal lwpolyline to make its clone orthogonalized..."))) (= (cdr (assoc 0 (setq lwx (entget lw)))) "LWPOLYLINE") (vl-every (function (lambda ( x ) (= (cdr x) 0.0))) (vl-remove-if (function (lambda ( x ) (/= (car x) 42))) lwx)) ) (progn (if (or (= (cdr (assoc 70 lwx)) 1) (= (cdr (assoc 70 lwx)) 129)) (setq cl t) ) (setq pl (mapcar (function (lambda ( p ) (trans p lw 1))) (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) lwx)))) (if cl (setq pl (append pl (list (car pl)))) ) (if (> (length pl) 2) (entmake (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length (setq pl (f pl)))) (cons 70 (if cl (1+ (* 128 (getvar (quote plinegen)))) (* 128 (getvar (quote plinegen))))) (assoc 38 lwx) ) (mapcar (function (lambda ( x ) (cons 10 x))) (mapcar (function (lambda ( p ) (trans p 1 lw))) pl)) (list (cons 62 3) (assoc 210 lwx) ) ) ) (prompt "\nPicked lwpolyline with insufficient number of vertices...") ) ) (prompt "\nMissed, or picked entity not polygonal lwpolyline... Better luck next time...") ) (princ) ) (defun c:lw_orth-grread ( / un f p lw lwx pl ppl cl lwn lwnx gr pp pre suf ) (defun un ( l / a ll ) (while (setq a (car l)) (if (vl-some (function (lambda ( x ) (equal x a 1e-10))) l) (setq ll (cons a ll) l (vl-remove-if (function (lambda ( x ) (equal x a 1e-10))) (cdr l))) (setq ll (cons a ll) l (cdr l)) ) ) (reverse ll) ) (defun f ( l / i p1 p2 px r ) (if (> (length l) 2) (progn (setq i -1) (while (< (setq i (1+ i)) (1- (length l))) (if (not p1) (setq p1 (nth i l) p2 (nth (1+ i) l)) (setq p1 p2 p2 (nth (1+ i) l)) ) (if (= i 0) (setq r (cons (car l) r)) ) (setq r (cons (if (setq px (p p1 p2 p2)) (setq p2 px) p2) r)) (if (= i (- (length l) 2)) (setq r (cons (last l) r)) ) ) (setq r (reverse r)) (un (apply (function append) (mapcar (function (lambda ( p1 p2 / pp ) (if (setq pp (vl-some (function (lambda ( x ) (if (and (equal (distance p1 p2) (+ (distance p1 x) (distance x p2)) 1e-10) (not (equal x p1 1e-10)) (not (equal x p2 1e-10))) x))) l)) (list p1 pp) (list p1)))) r (append (cdr r) (list (car r)))))) ) ) ) (defun p ( p1 p2 p3 / p21 p22 ) (setq p21 (inters p1 (polar p1 (* 0.5 pi) 1.0) p3 (polar p3 0.0 1.0) nil)) (setq p22 (inters p1 (polar p1 0.0 1.0) p3 (polar p3 (* 0.5 pi) 1.0) nil)) (if (< (distance p2 p21) (distance p2 p22)) p21 p22 ) ) (if (and (setq lw (car (entsel "\nPick polygonal lwpolyline to make its clone orthogonalized..."))) (= (cdr (assoc 0 (setq lwx (entget lw)))) "LWPOLYLINE") (vl-every (function (lambda ( x ) (= (cdr x) 0.0))) (vl-remove-if (function (lambda ( x ) (/= (car x) 42))) lwx)) ) (progn (if (or (= (cdr (assoc 70 lwx)) 1) (= (cdr (assoc 70 lwx)) 129)) (setq cl t) ) (setq pl (mapcar (function (lambda ( p ) (trans p lw 1))) (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) lwx)))) (if cl (setq pl (append pl (list (car pl)))) ) (if (> (length pl) 2) (setq lwn (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length (setq ppl (f pl)))) (cons 70 (if cl (1+ (* 128 (getvar (quote plinegen)))) (* 128 (getvar (quote plinegen))))) (assoc 38 lwx) ) (mapcar (function (lambda ( x ) (cons 10 x))) (mapcar (function (lambda ( p ) (trans p 1 lw))) ppl)) (list (cons 62 3) (assoc 210 lwx) ) ) ) ) (prompt "\nPicked lwpolyline with insufficient number of vertices...") ) (vl-cmdf "_.ucs" "_m" (mapcar (function +) (list 0.0 0.0) (getvar (quote viewctr)))) (if (and lwn (setq lwnx (entget lwn)) (setq pre (reverse (member (assoc 39 lwnx) (reverse lwnx)))) (setq suf (list (assoc 210 lwnx)))) (while (= (car (setq gr (grread t))) 5) (setq pp (cadr gr)) (vl-cmdf "_.ucs" "_3p" "_non" (list 0.0 0.0) "_non" pp "") (setq pl (mapcar (function (lambda ( p ) (trans p lw 1))) (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) lwx)))) (if cl (setq pl (append pl (list (car pl)))) ) (setq pre (subst (cons 90 (length (setq ppl (f pl)))) (assoc 90 pre) pre)) (entupd (cdr (assoc -1 (entmod (append pre (mapcar (function (lambda ( x ) (cons 10 x))) (mapcar (function (lambda ( p ) (trans p 1 lw))) ppl)) suf))))) ) ) ) (prompt "\nMissed, or picked entity not polygonal lwpolyline... Better luck next time...") ) (princ) ) BTW. As addition to previous version, now there is (grread) implementation... (grsnap) is here unnecessary... HTH. Regards, M.R.

You can try changing the tolerance to simplify the result. However, the result will be different from what you get with dexus or GP_ codes because mine is designed so that any point on the center line is equidistant and the interior of the segments never exceeds the user-defined tolerance.

I did see a for-purchase program that used a raster image and maybe worked with QGIS, I'll see if I can find it again, the demo video looked pretty good and even split around islands, side branches, etc.. It had a lot of parameters to fill out in a window for what to grab, so still a good bit of work, IIRC.