Leaderboard

Calculating an axis using angle bisectors a) Attempt number 1 (it was my first impulse, but I came up with a better one later) Advantages: - Pure LISP: doesn't depend on Express Tools, - It's faster Disadvantages: - The result isn't as good as @GP_'s "c:CPL" - It only accepts LWPOLYLINES and ignores arcs Basically, the approach is to obtain angle bisectors on each polyline, extend them to the other reference polyline, and use their midpoints. The result is acceptably good, but not as accurate as c:CPL. (defun c:creAxis (/ e e1 e2 l1 l2 lr p p0 p1 p2 px pm abis lii pmi pfi pi1 pi2 pf1 pf2 dameInters+Prox ordena) (defun dameInters+Prox (p0 a lp / p1 px pt1 pt2 dmin d pf) (setq pt1 (polar p0 a 1e8) pt2 (polar p0 (+ a PI) 1e8)) (foreach p lp (if p1 (if (setq px (inters pt1 pt2 p1 p)) (if dmin (if (< (setq d (distance px p0)) dmin) (setq dmin d pf px)) (setq dmin (distance px p0) pf px)) ) ) (setq p1 p) ) pf ) (defun ordena (pr lp / d dmin ps lr) (while lp (foreach p lp (if dmin (if (< (setq d (distance p pr)) dmin) (setq dmin d ps p) ) (setq dmin (distance p pr) ps p) ) ) (setq dmin nil pr ps lp (vl-remove ps lp) lr (append lr (list ps))) ) ) (if (and (setq e1 (car (entsel "\nSelect first LWPOLYLINE..."))) (= (cdr (assoc 0 (setq l1 (entget e1)))) "LWPOLYLINE") (not (redraw e1 3))) (if (and (setq e2 (car (entsel "\nSelect second LWPOLYLINE..."))) (= (cdr (assoc 0 (setq l2 (entget e2)))) "LWPOLYLINE") (not (redraw e2 3))) (progn (setq lp1 (reverse (foreach l l1 (if (= (car l) 10) (setq lr (cons (cdr l) lr)) lr))) lr nil; lp2 (reverse (foreach l l2 (if (= (car l) 10) (setq lr (cons (cdr l) lr)) lr))) lr nil; ) (if (< (distance (setq pi1 (cdr (assoc 10 l1))) (setq pi2 (cdr (assoc 10 l2)))) (distance pi1 (setq pf2 (cdr (assoc 10 (reverse l2)))))) (setq pmi (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pi1 pi2) pfi (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (setq pf1 (cdr (assoc 10 (reverse l1)))) pf2) ) (setq pmi (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pi1 pf2) pfi (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (cdr (assoc 10 (reverse l1))) pi2) ) ) (redraw e1 4) (redraw e2 4) (foreach l l1 (if (= (car l) 10) (if p1 (if p2 (setq abis (+ (/ (+ (angle p1 p2) (angle p2 (cdr l))) 2) (/ PI 2.)) x (princ) px (dameInters+Prox p2 abis lp2) lr nil pm (if px (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p2 px)) lii (if px (append lii (list pm)) lii) p1 p2 p2 (cdr l) ) (setq p2 (cdr l)) ) (setq p1 (cdr l)) ) ) ) (setq p1 nil p2 nil lr nil) (foreach l l2 (if (= (car l) 10) (if p1 (if p2 (setq abis (+ (/ (+ (angle p1 p2) (angle p2 (cdr l))) 2.) (/ PI 2.)) px (dameInters+Prox p2 abis lp1); pm (if px (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p2 px) (princ) ) lii (if px (append lii (list pm)) lii); p1 p2 p2 (cdr l) ) (setq p2 (cdr l)) ) (setq p1 (cdr l)) ) ) ) (setq lii (append (list pmi) (ordena pmi lii) (list pfi))) ) ) ) (entmake (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbPolyline") (70 . 0) (60 . 0)) (list (cons 90 (length lii))) (mapcar '(lambda (a) (cons 10 a)) lii))) (princ) ) PS: It seems to work well, but I haven't tested it extensively. As I said at the beginning, there's a better approach, using angle bisectors, which I'll publish later.

If I get any time at home, I'll do some testing in AutoCAD 2000i.

It's true... sorry I'm curious to see if there are any differences.