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.

@Danielm103 How can AI be better than human revision? Here is AI - I've added "red" color... (defun c:ortho_pline ( / orthogonalize-points edata ent newpts p pl pts x) (defun orthogonalize-points (pts / dx-in dx-out dy-in dy-out i in-is-h new-x new-y out-is-h p0 p1 p2 result) ;; If fewer than 3 points, nothing to do (if (< (length pts) 3) pts (progn (setq result pts) ;; Iterate interior vertices (setq i 1) (while (< i (- (length pts) 1)) (setq p0 (nth (- i 1) result)) (setq p1 (nth i result)) (setq p2 (nth (+ i 1) result)) ;; Incoming vector p0 -> p1 (setq dx-in (- (car p1) (car p0))) (setq dy-in (- (cadr p1) (cadr p0))) ;; Outgoing vector p1 -> p2 (setq dx-out (- (car p2) (car p1))) (setq dy-out (- (cadr p2) (cadr p1))) ;; Dominant direction tests (setq in-is-h (>= (abs dx-in) (abs dy-in))) (setq out-is-h (>= (abs dx-out) (abs dy-out))) ;; Case 1: Proper corner (one horizontal, one vertical) (cond ((/= in-is-h out-is-h) (if in-is-h (progn ;; incoming horizontal, outgoing vertical (setq new-x (car p2)) (setq new-y (cadr p0)) ) (progn ;; incoming vertical, outgoing horizontal (setq new-x (car p0)) (setq new-y (cadr p2)) ) ) ) ;; Case 2: both horizontal (in-is-h (setq new-x (car p1)) (setq new-y (cadr p0)) ) ;; Case 3: both vertical (t (setq new-x (car p0)) (setq new-y (cadr p1)) ) ) ;; Replace interior point (setq result (subst (list new-x new-y) p1 result)) (setq i (1+ i)) ) result ) ) ) (setq ent (car (entsel "\nSelect a polyline: "))) (if (not ent) (progn (princ "\nNothing selected.") (exit) ) ) (setq edata (entget ent)) ;; Ensure LWPOLYLINE (if (/= (cdr (assoc 0 edata)) "LWPOLYLINE") (progn (princ "\nEntity is not a lightweight polyline.") (exit) ) ) ;; Extract vertices (group code 10) (setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) edata))) ;; Orthogonalize (setq newpts (orthogonalize-points pts)) ;; Create new polyline (setq pl (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length newpts)) '(70 . 0) ) (mapcar '(lambda (p) (cons 10 p)) newpts) (list '(62 . 1)) ) ) ) (if pl (princ "\nOrthogonal polyline created.") (princ "\nFailed to create polyline.") ) (princ) ) And here is my version - I used "green" color... (defun c:lw_orth ( / un f 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 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)) ) (if (< (abs (- (car p2) (car p1))) (abs (- (cadr p2) (cadr p1)))) (setq r (cons (setq p2 (list (car p1) (cadr p2))) r)) (setq r (cons (setq p2 (list (car p2) (cadr p1))) 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)))))) ) ) ) (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))))) (cons 38 0.0) ) (mapcar (function (lambda ( x ) (cons 10 x))) (mapcar (function (lambda ( p ) (trans p 1 lw))) pl)) (list (cons 62 3) (list 210 0.0 0.0 1.0) ) ) ) (prompt "\nPicked lwpolyline with insufficient number of vertices...") ) ) (prompt "\nMissed, or picked entity not polygonal lwpolyline... Better luck next time...") ) (princ) ) In attached *.DWG you can see that AI version makes mistake with finalizing segment - it isn't always orthogonal... Anyway interesting and fun for coding... Regards, M.R. orthogonalize_lwpolyline.dwg