;;; --------------------------------------------------------------------------- ;;; SquareToRound.lsp ;;; code compiled by YZ August 2026 ;;; --------------------------------------------------------------------------- ;;; FLAT PATTERN FOR A SQUARE-TO-ROUND TRANSITION ;;; ;;; PURPOSE ;;; Develops the flat blank for a transition piece: rectangular at one end, ;;; round at the other, with the round optionally offset from centre. This is ;;; the commonest fitting in sheet-metal ductwork and the one that cannot be ;;; laid out by eye. ;;; ;;; Give the rectangle, the diameter, the height and any offset, and it draws ;;; the developed pattern - the shape to cut from flat sheet, with its fold ;;; lines - ready to plot at 1:1 and mark out. ;;; ;;; HOW A TRANSITION IS DEVELOPED ;;; The piece is made of four flat triangular panels, one per side of the ;;; rectangle, separated by four conical corners. Flat panels lay out directly; ;;; the cones do not, so they are TRIANGULATED. ;;; ;;; The round end is walked in one-degree steps. At each step: ;;; ;;; 1. The true length is found from the rectangle corner to that point on ;;; the circle - the diagonal of the horizontal offset and the height, ;;; which is a straight application of Pythagoras in three dimensions. ;;; ;;; 2. That true length, the previous one, and the one-degree arc between ;;; them form a thin triangle. Its apex angle comes from Heron's formula: ;;; with semi-perimeter s and inradius r, the half-angle opposite side c ;;; has tangent r/(s-c). ;;; ;;; 3. Those apex angles accumulate. The running total is the angle the ;;; pattern has swept at that point, and the true length is its radius. ;;; ;;; Every fifteenth degree the pair is kept, giving six points per corner and ;;; twenty-four round the pattern. Stepping at one degree and keeping every ;;; fifteenth is deliberate: the ANGLES must accumulate finely to be accurate, ;;; but the drawn curve only needs enough points to fit smoothly. ;;; ;;; THE PATTERN IS EXACT ;;; Triangulation is not an approximation of the shape - a transition really is ;;; made of flat triangles, and this lays out the true size of each. Cut to ;;; this and it rolls up to the right piece. ;;; ;;; SQTOROUND - develop the flat pattern for a square-to-round transition ;;; --------------------------------------------------------------------------- ;;; --------------------------------------------------------------------------- ;;; SESSION MEMORY ;;; --------------------------------------------------------------------------- (if (null *SqRound:Prefs*) (setq *SqRound:Prefs* (list (cons "X1" 12.0) ; rectangle, X (cons "Y1" 12.0) ; rectangle, Y (cons "X2" 0.0) ; round offset from centre, X (cons "Y2" 0.0) ; round offset from centre, Y (cons "Z" 12.0) ; height between the two ends (cons "DIA" 8.0) ; round diameter ) ) ) (defun SqRound:Get ( key ) (cdr (assoc key *SqRound:Prefs*))) (defun SqRound:Put ( key val ) (setq *SqRound:Prefs* (cons (cons key val) (vl-remove-if '(lambda (p) (= (car p) key)) *SqRound:Prefs*))) val ) ;;; Offsets may be negative or zero - the round can sit anywhere over the ;;; rectangle, including dead centre. (defun SqRound:Ask ( key prompt allowAny / v ) (initget (if allowAny 0 6)) (setq v (getreal (strcat "\n" prompt " <" (rtos (SqRound:Get key) 2 3) ">: "))) (if v (SqRound:Put key v) (SqRound:Get key)) ) ;;; --------------------------------------------------------------------------- ;;; ONE CORNER, TRIANGULATED ;;; ;;; Walks 90 degrees of the round end in one-degree steps, accumulating the ;;; developed angle and recording the state every fifteenth degree. ;;; ;;; startLen true length at the start of this corner, carried over from the ;;; flat panel that precedes it ;;; sx sy which way the offset applies in this corner, +1 or -1 ;;; useCos which of the two circle coordinates leads - the four corners are ;;; traversed in alternating senses ;;; ;;; Returns ( total-angle (angle . length) x6 ) with the six kept in the order ;;; they were generated. ;;; --------------------------------------------------------------------------- (defun SqRound:Corner ( startLen sx sy useCos x1 y1 x2 y2 z dia / rad arc prev total deg rads dx dy a b len s r ang kept ) (setq rad (/ dia 2.0) ;; Arc length of one degree of the round end. This is the third side of ;; every triangle in this corner. arc (/ (* pi dia) 360.0) prev startLen total 0.0 deg 0 kept nil) (while (< deg 90) (setq deg (1+ deg) rads (* pi (/ (float deg) 180.0))) ;; Position on the round end at this step. (if useCos (setq dx (* rad (cos rads)) dy (* rad (sin rads))) (setq dx (* rad (sin rads)) dy (* rad (cos rads)))) ;; True length from the rectangle corner to that point: the horizontal ;; offsets in X and Y, and the height, as one 3D diagonal. (setq a (+ (/ x1 2.0) (* x2 sx) (- dx)) b (+ (/ y1 2.0) (* y2 sy) (- dy)) len (sqrt (+ (* a a) (* b b) (* z z))) ;; Apex angle of the triangle (len, prev, arc), by Heron: ;; semi-perimeter s, inradius r, and tan(half-angle) = r/(s-c). s (/ (+ len prev arc) 2.0) r (sqrt (/ (* (- s len) (- s prev) (- s arc)) s)) ang (* 2.0 (atan (/ r (- s arc)))) total (+ total ang) prev len) ;; Six points per corner is enough to fit a smooth curve through. (if (zerop (rem deg 15)) (setq kept (cons (cons total len) kept)))) (cons total (reverse kept)) ) ;;; --------------------------------------------------------------------------- ;;; MAIN COMMAND ;;; --------------------------------------------------------------------------- (defun c:SQTOROUND ( / *error* vars vals x1 y1 x2 y2 z dia l12 l23 l34 l45 l2 l4 l6 l8 l1a l1b l3a l3b l5a l5b l7a l7b c1 c2 c3 c4 t1 t2 t3 t4 t1a t1b t2a t2b t3a t3b t4a t4b devs p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 arcPts q base k ref i pt ent ) (setq vars '("CMDECHO" "OSMODE" "BLIPMODE" "CLAYER") vals (mapcar 'getvar vars)) (defun SqRound: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 ) (SqRound:Restore) (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))) (princ (strcat "\n** SQTOROUND error: " msg " **"))) (princ) ) (setvar "CMDECHO" 0) ;; AutoCAD 2015 and later refuse (command) inside an *error* handler ;; unless the routine says up front that it will use one. Restore does, ;; to close this undo group. (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '()) (command "_.UNDO" "_Begin") (setq x1 (SqRound:Ask "X1" "Rectangle size, X" nil) y1 (SqRound:Ask "Y1" "Rectangle size, Y" nil) x2 (SqRound:Ask "X2" "Round offset from centre, X" t) y2 (SqRound:Ask "Y2" "Round offset from centre, Y" t) z (SqRound:Ask "Z" "Height between the two ends" nil) dia (SqRound:Ask "DIA" "Round diameter" nil)) (cond ((>= dia (min x1 y1)) (princ "\n** The round is as large as the rectangle - that is a straight duct. **")) ((or (>= (abs (* 2.0 x2)) x1) (>= (abs (* 2.0 y2)) y1)) (princ "\n** The offset puts the round outside the rectangle. **")) (t (setvar "OSMODE" 0) (setvar "BLIPMODE" 0) ;; --- the four sides of the rectangle, split by the offset -------- (setq l12 (- (/ x1 2.0) x2) l23 (+ (/ x1 2.0) x2) l34 (+ (/ y1 2.0) y2) l45 (- (/ y1 2.0) y2)) ;; --- slant heights from each side to the nearest point on the round (setq l2 (sqrt (+ (* z z) (expt (- (+ (/ y1 2.0) y2) (/ dia 2.0)) 2))) l4 (sqrt (+ (* z z) (expt (- (+ (/ x1 2.0) x2) (/ dia 2.0)) 2))) l6 (sqrt (+ (* z z) (expt (- (/ y1 2.0) (+ (/ dia 2.0) y2)) 2))) l8 (sqrt (+ (* z z) (expt (- (/ x1 2.0) (+ (/ dia 2.0) x2)) 2)))) ;; --- true lengths of the eight seams at the corners -------------- (setq l1a (sqrt (+ (* l2 l2) (* l12 l12))) l1b (sqrt (+ (* l8 l8) (* l34 l34))) l3a (sqrt (+ (* l4 l4) (* l34 l34))) l3b (sqrt (+ (* l2 l2) (* l23 l23))) l5a (sqrt (+ (* l6 l6) (* l23 l23))) l5b (sqrt (+ (* l4 l4) (* l45 l45))) l7a (sqrt (+ (* l8 l8) (* l45 l45))) l7b (sqrt (+ (* l6 l6) (* l12 l12)))) (princ "\nDeveloping the four corners ...") ;; --- triangulate each corner ------------------------------------ ;; The four are traversed in alternating senses, which is what the ;; sign pair and the cos/sin swap encode. (setq c1 (SqRound:Corner l3b 1.0 1.0 nil x1 y1 x2 y2 z dia) c2 (SqRound:Corner l5b 1.0 -1.0 t x1 y1 x2 y2 z dia) c3 (SqRound:Corner l7b -1.0 -1.0 nil x1 y1 x2 y2 z dia) c4 (SqRound:Corner l1b -1.0 1.0 t x1 y1 x2 y2 z dia)) ;; Twenty-four kept states, in the order the pattern runs. (setq devs (append (cdr c1) (cdr c2) (cdr c3) (cdr c4))) ;; --- flat panel angles at each corner --------------------------- (setq t1a (atan l2 l23) t1b (atan l4 l34) t2a (atan l4 l45) t2b (atan l6 l23) t3a (atan l6 l12) t3b (atan l8 l45) t4a (atan l8 l34) t4b (atan l2 l12) ;; Each corner's total turn: the two flat panels either side, ;; plus everything the cone between them accumulated. t1 (+ t1a t1b (car c1)) t2 (+ t2a t2b (car c2)) t3 (+ t3a t3b (car c3)) t4 (+ t4a t4b (car c4))) ;; --- lay out the rectangle end ----------------------------------- ;; Each side is turned by the running total of the corners so far. (setq p0 '(0.0 0.0) p1 (polar p0 0.0 l23) p2 (polar p1 (- pi t1) y1) p3 (polar p2 (- (* 2 pi) (+ t1 t2)) x1) p4 (polar p3 (- (* 3 pi) (+ t1 t2 t3)) y1) p5 (polar p4 (- (* 4 pi) (+ t1 t2 t3 t4)) l12) ;; The four seam lines back to the round. p6 (polar p4 (- (* 4 pi) (+ t1 t2 t3 t4a (car c4))) l1a) p7 (polar p3 (- (* 3 pi) (+ t1 t2 t3a (car c3))) l7a) p8 (polar p2 (- (* 2 pi) (+ t1 t2a (car c2))) l5a) p9 (polar p1 (- pi (+ t1a (car c1))) l3a) p10 (polar p0 (* pi 0.5) l2)) ;; --- lay out the developed curve -------------------------------- ;; Six points per corner, each swung from that corner's base point ;; by the accumulated angle, at the accumulated true length. (setq arcPts nil q 0) (repeat 4 (setq base (nth q (list p1 p2 p3 p4)) k (1+ q) ref (nth q (list t1a (+ t1 t2a) (+ t1 t2 t3a) (+ t1 t2 t3 t4a))) i 0) (repeat 6 (setq pt (nth (+ (* q 6) i) devs) arcPts (cons (polar base (- (* k pi) ref (car pt)) (cdr pt)) arcPts) i (1+ i))) (setq q (1+ q))) (setq arcPts (reverse arcPts)) ;; --- draw -------------------------------------------------------- (if (tblsearch "layer" "SQTOROUND") (command "_.LAYER" "_ON" "SQTOROUND" "_THAW" "SQTOROUND" "_UNLOCK" "SQTOROUND" "") (command "_.LAYER" "_NEW" "SQTOROUND" "")) (setvar "CLAYER" "SQTOROUND") ;; Outline and the four corner seams. (command "_.LINE" p10 p0 p1 p2 p3 p4 p5 p6 p4 p7 p3 p8 p2 p9 p1 p10 "") ;; Two fold lines inside each corner, at the second and fourth ;; kept point - enough to mark the cone without cluttering it. (setq q 0) (repeat 4 (command "_.LINE" (nth (+ (* q 6) 1) arcPts) (nth q (list p1 p2 p3 p4)) (nth (+ (* q 6) 3) arcPts) "") (setq q (1+ q))) ;; The developed curve, fitted smooth. (command "_.PLINE" p10) (foreach p arcPts (command p)) (command "") (setq ent (entlast)) (vl-catch-all-apply '(lambda ( ) (command "_.PEDIT" ent "_F" "_X"))) (command "_.ZOOM" "_E") (princ (strcat "\nFlat pattern developed - " (rtos x1 2 2) " x " (rtos y1 2 2) " to " (rtos dia 2 2) " round, " (rtos z 2 2) " high" (if (and (zerop x2) (zerop y2)) ", concentric" (strcat ", offset " (rtos x2 2 2) " / " (rtos y2 2 2))) ".")) ) ) (SqRound:Restore) (princ) ) (princ)