;;; --------------------------------------------------------------------- ;;; MIDALIGN-bgol.lsp ;;; Command: MIDL ;;; ;;; PURPOSE ;;; Derives a genuine centerline between two selected edge polylines ;;; (e.g. the two edges of a surveyed road) by sampling both curves at ;;; matching parametric positions and connecting the midpoints. Works ;;; correctly even when the two edges are not perfectly parallel, ;;; unlike the native OFFSET command. ;;; ;;; USAGE ;;; 1. Load this file (APPLOAD or drag-drop onto the drawing window). ;;; 2. Type MIDL at the command line and press Enter. ;;; 3. Select the first edge polyline, then the second edge polyline. ;;; 4. A new centerline polyline is drawn between them on layer ;;; "BGOL-MIDL". The original edge polylines are left untouched. ;;; ;;; NOTES ;;; - Sampling density defaults to *bgol-midl-samples* points; edit ;;; the constant below for a smoother or coarser centerline. ;;; - This is an original, independently written implementation. ;;; It is INSPIRED by the general idea of edge-to-centerline ;;; derivation utilities common in CAD/survey drafting workflows, ;;; but the code, command name and file name here are new and are ;;; NOT copied from, nor identical to, any specific third-party ;;; product. ;;; ;;; --------------------------------------------------------------------- ;;; Developed and shared for the CAD community by: BGol Community ;;; Community website: https://bgol.in/ ;;; License: Open-source & free to use, modify, and share for all. ;;; Provided "as is", without warranty of any kind. ;;; --------------------------------------------------------------------- (vl-load-com) (setq *bgol-midl-samples* 24) ; number of midpoint samples along the pair (defun BGOL:MIDL-EnsureLayer (lname / ) (if (not (tblsearch "LAYER" lname)) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 lname) '(70 . 0) '(62 . 2) ; yellow '(6 . "Continuous"))) ) ) (defun BGOL:MIDL-MakePolyline (pointlist lname / dxfdata pt) (setq dxfdata (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 lname) '(100 . "AcDbPolyline") (cons 90 (length pointlist)) '(70 . 0) ) ) (foreach pt pointlist (setq dxfdata (append dxfdata (list (cons 10 pt)))) ) (entmakex dxfdata) ) (defun C:MIDL ( / e1 e2 obj1 obj2 sp1 ep1 sp2 ep2 n i frac t1 t2 p1 p2 mid pts) (BGOL:MIDL-EnsureLayer "BGOL-MIDL") (setq e1 (car (entsel "\nSelect first edge polyline: "))) (setq e2 (if e1 (car (entsel "\nSelect second edge polyline: ")))) (if (and e1 e2) (progn (setq obj1 (vlax-ename->vla-object e1)) (setq obj2 (vlax-ename->vla-object e2)) (setq sp1 (vlax-curve-getStartParam obj1)) (setq ep1 (vlax-curve-getEndParam obj1)) (setq sp2 (vlax-curve-getStartParam obj2)) (setq ep2 (vlax-curve-getEndParam obj2)) (setq n (max 4 *bgol-midl-samples*)) (setq pts '()) (setq i 0) (while (<= i n) (setq frac (/ (float i) n)) (setq t1 (+ sp1 (* frac (- ep1 sp1)))) (setq t2 (+ sp2 (* frac (- ep2 sp2)))) (setq p1 (vlax-curve-getPointAtParam obj1 t1)) (setq p2 (vlax-curve-getPointAtParam obj2 t2)) (if (and p1 p2) (progn (setq mid (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)) (setq pts (append pts (list (list (car mid) (cadr mid))))) ) ) (setq i (1+ i)) ) (if (>= (length pts) 2) (progn (BGOL:MIDL-MakePolyline pts "BGOL-MIDL") (princ (strcat "\nMIDL: centerline created with " (itoa (length pts)) " vertices (layer BGOL-MIDL).")) ) (princ "\nCould not compute enough midpoints; centerline not created.") ) ) (princ "\nBoth edges must be selected to compute a centerline.") ) (princ) ) (princ "\nMIDALIGN-bgol.lsp loaded. Type MIDL to derive a centerline between two edge polylines.") (princ "\n -- Free & open-source, courtesy of BGol Community (https://bgol.in/) --") (princ)