;;; --------------------------------------------------------------------- ;;; SEGLEN-bgol.lsp ;;; Command: SGL ;;; ;;; PURPOSE ;;; Measures and labels the length of every individual segment of a ;;; selected polyline in one command. Each length label is rotated to ;;; align with its segment's direction, producing a clean, readable ;;; survey-boundary-style annotation without manual per-segment ;;; dimensioning. ;;; ;;; USAGE ;;; 1. Load this file (APPLOAD or drag-drop onto the drawing window). ;;; 2. Type SGL at the command line and press Enter. ;;; 3. Select the polyline whose segments should be measured. ;;; 4. A length label is placed at the midpoint of every segment, ;;; rotated to match the segment's angle, on layer "BGOL-SGL". ;;; ;;; NOTES ;;; - Text rotation is normalized so labels never appear upside-down ;;; (angles beyond 90-270 degrees are flipped by 180 degrees). ;;; - This is an original, independently written implementation. ;;; It is INSPIRED by the general idea of segment-length labeling ;;; utilities common in survey/civil 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) (defun BGOL:SGL-EnsureLayer (lname / ) (if (not (tblsearch "LAYER" lname)) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 lname) '(70 . 0) '(62 . 3) ; green '(6 . "Continuous"))) ) ) (defun BGOL:SGL-GetVerts (obj / coords pts) (setq coords (vlax-safearray->list (vlax-variant-value (vlax-get obj 'Coordinates)))) (setq pts '()) (while coords (setq pts (append pts (list (list (car coords) (cadr coords))))) (setq coords (cddr coords)) ) pts ) (defun BGOL:SGL-MakeText (pt txt ang ht lname) (entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") (cons 8 lname) '(100 . "AcDbText") (cons 10 pt) (cons 40 ht) (cons 1 txt) (cons 50 ang) (cons 72 1) (cons 11 pt) '(100 . "AcDbText"))) ) (defun C:SGL ( / ent obj verts closed n i p1 p2 seglen segang midpt txt cnt) (BGOL:SGL-EnsureLayer "BGOL-SGL") (setq ent (car (entsel "\nSelect polyline to measure segments: "))) (if ent (progn (setq obj (vlax-ename->vla-object ent)) (setq closed (vlax-get obj 'Closed)) (setq verts (BGOL:SGL-GetVerts obj)) (setq n (length verts)) (setq cnt 0) (setq i 0) (while (< i (1- n)) (setq p1 (nth i verts)) (setq p2 (nth (1+ i) verts)) (setq seglen (distance p1 p2)) (setq segang (angle p1 p2)) (if (or (> segang (/ pi 2.0)) (< segang (- (/ pi 2.0)))) (if (and (> segang (/ pi 2.0)) (<= segang (* pi 1.5))) (setq segang (- segang pi)) ) ) (setq midpt (list (/ (+ (car p1) (car p2)) 2.0) (/ (+ (cadr p1) (cadr p2)) 2.0))) (setq txt (rtos seglen 2 2)) (BGOL:SGL-MakeText midpt txt segang 2.5 "BGOL-SGL") (setq cnt (1+ cnt)) (setq i (1+ i)) ) (if closed (progn (setq p1 (last verts)) (setq p2 (car verts)) (setq seglen (distance p1 p2)) (setq segang (angle p1 p2)) (if (and (> segang (/ pi 2.0)) (<= segang (* pi 1.5))) (setq segang (- segang pi)) ) (setq midpt (list (/ (+ (car p1) (car p2)) 2.0) (/ (+ (cadr p1) (cadr p2)) 2.0))) (setq txt (rtos seglen 2 2)) (BGOL:SGL-MakeText midpt txt segang 2.5 "BGOL-SGL") (setq cnt (1+ cnt)) ) ) (princ (strcat "\nSGL: labeled " (itoa cnt) " segment(s) with rotated length text (BGOL-SGL).")) ) (princ "\nNo polyline selected.") ) (princ) ) (princ "\nSEGLEN-bgol.lsp loaded. Type SGL to label every segment length of a polyline.") (princ "\n -- Free & open-source, courtesy of BGol Community (https://bgol.in/) --") (princ)