;;; --------------------------------------------------------------------------- ;;; TextBracket.lsp ;;; code compiled by YZ August 2026 ;;; --------------------------------------------------------------------------- ;;; BRACKETS AROUND A GROUP OF NOTES ;;; ;;; PURPOSE ;;; Draws the tall bracket used to gather several lines of text and point them ;;; at one thing - a group of notes against a leader, a schedule of parts ;;; against an item, a set of options against a single answer. ;;; ;;; |‾‾‾‾ ‾‾‾‾| ;;; | | ;;; |___ ___| ;;; ;;; Pick the two ends of the span and say how far it should reach. Corners can ;;; be square, chamfered or rounded. ;;; ;;; WHAT WAS FIXED ;;; - The routine could not run. It contained ;;; ;;; (command "pline" pt1 ^C) ;;; ;;; where ^C was meant as a cancel. That works in a MENU macro, where ^C is ;;; two characters the menu system reads as Escape - but in LISP it is a ;;; symbol named ^C, which is unbound, evaluates to nil, and leaves PLINE ;;; open at a prompt. The whole point of the line was to see the current ;;; polyline width, which SETVAR reads directly. ;;; - It ended its polylines with \r, which is likewise not a carriage return ;;; in LISP but a symbol. It happened to work because an unbound symbol is ;;; nil and nil closes a command, but only by luck. ;;; - It changed FILLETRAD, CHAMFERA and CHAMFERB to get its corners and left ;;; all three at the new values. ;;; - It added 0.01 to whatever radius you gave, then subtracted it again when ;;; setting the variable, for no reason that survives reading. ;;; - Five variables were global, including one called ANGLE - which shadows ;;; the built-in ANGLE function for anything that runs afterwards. ;;; ;;; BRACKET - draw a bracket around a group of notes ;;; --------------------------------------------------------------------------- (setq *Bracket:Depth* nil *Bracket:Corner* nil) (defun Brack:Layer ( name colour ) (if (not (tblsearch "LAYER" name)) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 name) '(70 . 0) (cons 62 colour) '(6 . "Continuous")))) name ) ;;; A polyline from (point . bulge) pairs, at a set width. (defun Brack:Poly ( pairs width layer ) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 layer) '(100 . "AcDbPolyline") (cons 90 (length pairs)) '(70 . 0) (cons 43 width)) (apply 'append (mapcar '(lambda ( pr ) (list (cons 10 (list (car (car pr)) (cadr (car pr)))) (cons 42 (cdr pr)))) pairs)))) ) (defun c:BRACKET ( / *error* vars vals p1 p2 depth style lay width v ang perp mid pairs corner b arm ) (setq vars '("CMDECHO" "BLIPMODE" "OSMODE" "CLAYER") vals (mapcar 'getvar vars)) (defun Brack:Restore ( ) (mapcar 'setvar vars vals) (while (= 8 (logand 8 (getvar 'undoctl))) (command "_.UNDO" "_End")) (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '()) (princ) ) (defun *error* ( msg ) (Brack:Restore) (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))) (princ (strcat "\n** BRACKET error: " msg " **"))) (princ) ) (setvar "CMDECHO" 0) (setvar "BLIPMODE" 0) ;; AutoCAD 2015 and later refuse (command) inside an *error* handler unless ;; the routine says up front that it will use one. (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '()) (command "_.UNDO" "_Begin") (setq p1 (getpoint "\nOne end of the bracket: ")) (if p1 (setq p2 (getpoint p1 "\nThe other end: "))) (if (or (null p1) (null p2)) (princ "\nCancelled.") (progn (setvar "OSMODE" 0) (initget 6) (setq depth (getdist p2 (strcat "\nHow far the arms reach" (if *Bracket:Depth* (strcat " <" (rtos *Bracket:Depth* 2 3) ">") "") ": "))) (if (null depth) (setq depth *Bracket:Depth*)) (if (null depth) (princ "\nNo depth given.") (progn (setq *Bracket:Depth* depth) (initget "Square Chamfer Round") (setq style (getkword (strcat "\nCorners [Square/Chamfer/Round] <" (cond (*Bracket:Corner*) (t "Square")) ">: "))) (if (null style) (setq style (cond (*Bracket:Corner*) (t "Square")))) (setq *Bracket:Corner* style) (setq corner 0.0) (if (/= style "Square") (progn (initget 6) (setq v (getdist (strcat "\n Corner size <" (rtos (/ depth 4.0) 2 3) ">: "))) (setq corner (if v v (/ depth 4.0))) ;; A corner cannot eat more than half of either leg. (setq corner (min corner (/ depth 2.0) (/ (distance p1 p2) 4.0))))) ;; Width from the current polyline width, read directly - ;; not by drawing a scratch polyline to look at. (setq width (getvar "PLINEWID")) (if (or (null width) (< width 0.0)) (setq width 0.0)) (setq lay (Brack:Layer "Notes" 7) ang (angle p1 p2) arm 1.0 ; which way PERP turns perp (+ ang (/ pi 2.0))) ;; The arms point to whichever side you indicate. (setq v (getpoint (polar p1 ang (/ (distance p1 p2) 2.0)) "\nWhich side should the arms point: ")) (if (and v (minusp (- (* (cos ang) (- (cadr v) (cadr p1))) (* (sin ang) (- (car v) (car p1)))))) (setq perp (- perp pi) arm -1.0)) ;; --- build it ------------------------------------------- ;; In along one arm, round the corner, across the back, ;; round the far corner and out along the other arm. ;; ;; Each corner is a quarter turn, and a quarter turn has a ;; bulge of tan(90/4) - about 0.4142. Travelling in along the ;; arm and then out along the back is a LEFT turn when the ;; arms point to the left of the run, so the sign follows ;; which side was chosen. A chamfer is the same corner cut ;; straight across, which is the same points with no bulge. (setq b (if (= style "Round") (* arm 0.4142) 0.0)) (setq pairs (if (= style "Square") ;; Nothing to cut - straight into the corner. (list (cons (polar p1 perp depth) 0.0) (cons p1 0.0) (cons p2 0.0) (cons (polar p2 perp depth) 0.0)) (list (cons (polar p1 perp depth) 0.0) (cons (polar p1 perp corner) b) (cons (polar p1 ang corner) 0.0) (cons (polar p2 ang (- corner)) b) (cons (polar p2 perp corner) 0.0) (cons (polar p2 perp depth) 0.0)))) (Brack:Poly pairs width lay) (princ (strcat "\nBracket " (rtos (distance p1 p2) 2 3) " across, arms " (rtos depth 2 3) ", " (strcase style t) " corners."))))) ) (Brack:Restore) (princ) ) (princ)