;;; ---------------------------------------------------------------------------
;;; ShopShapes.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; THREE SHAPES AUTOCAD HAS NO COMMAND FOR
;;;
;;;   SPIRAL  a flat Archimedean spiral - the kind used for coils, springs seen
;;;           on edge, scroll details and clock springs. HELIX draws a 3D helix
;;;           and cannot do this.
;;;
;;;   SLOT    a slotted hole - two semicircular ends joined by parallel sides, at
;;;           any angle. Drawn as ONE closed polyline, so it can be offset,
;;;           hatched or used as a trim boundary in one piece.
;;;
;;;   FLANGE  a bolted flange in plan - outside diameter, bore, bolt circle and
;;;           any number of bolt holes set out from a start angle.
;;;
;;; TWO CORRECTED DEFECTS
;;;   The routines these were rebuilt from both had real bugs.
;;;
;;;   The slot did (polar lastpoint A B) where A was the slot RADIUS, not an
;;;   angle - so the straight side ran off at an angle equal to the radius in
;;;   radians, and the slot only closed when the radius happened to be near zero.
;;;
;;;   The flange's validation loop set its two error flags when the bolt circle
;;;   was OUT of range, then exited the loop when BOTH flags were set. So it
;;;   accepted a bolt circle only if it was simultaneously bigger than the
;;;   outside diameter and smaller than the bore - which is impossible - and
;;;   looped forever on every valid answer.
;;;
;;;   SPIRAL  SLOT  FLANGE
;;; ---------------------------------------------------------------------------

;;; ---------------------------------------------------------------------------
;;; SESSION MEMORY
;;; ---------------------------------------------------------------------------

(if (null *ShopShapes:Prefs*)
    (setq *ShopShapes:Prefs*
        (list (cons "TURNS"    3)      ; spiral rotations
              (cons "GROWTH"   1.0)    ; spiral growth per rotation
              (cons "SEGS"     36)     ; spiral points per rotation
              (cons "SLOTRAD"  0.25)   ; slot end radius
              (cons "SLOTLEN"  1.0)    ; slot centre-to-centre length
              (cons "OD"       6.0)    ; flange outside radius
              (cons "ID"       2.0)    ; flange bore radius
              (cons "BC"       4.5)    ; bolt circle radius
              (cons "HOLE"     0.5)    ; bolt hole diameter
              (cons "NHOLES"   8)      ; number of bolt holes
        )
    )
)

(defun ShopShapes:Get ( key ) (cdr (assoc key *ShopShapes:Prefs*)))

(defun ShopShapes:Put ( key val )
    (setq *ShopShapes:Prefs*
        (cons (cons key val)
              (vl-remove-if '(lambda (p) (= (car p) key)) *ShopShapes:Prefs*)))
    val
)

(defun ShopShapes:AskDist ( key prompt / v )
    (initget 6)
    (setq v (getdist (strcat "\n" prompt " <" (rtos (ShopShapes:Get key) 2 4) ">: ")))
    (if v (ShopShapes:Put key v) (ShopShapes:Get key))
)

(defun ShopShapes:AskInt ( key prompt / v )
    (initget 6)
    (setq v (getint (strcat "\n" prompt " <" (itoa (ShopShapes:Get key)) ">: ")))
    (if v (ShopShapes:Put key v) (ShopShapes:Get key))
)

;;; ---------------------------------------------------------------------------
;;; SHARED
;;; ---------------------------------------------------------------------------

(setq ShopShapes:VARS '("CMDECHO" "OSMODE" "BLIPMODE" "CLAYER" "PLINEWID"))

(defun ShopShapes:Save ( ) (mapcar 'getvar ShopShapes:VARS))

(defun ShopShapes:Restore ( vals )
    (mapcar 'setvar ShopShapes:VARS vals)
    (while (= 8 (logand 8 (getvar 'undoctl))) (command "_.UNDO" "_End"))
    (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
    (princ)
)

(defun ShopShapes:Layer ( name )
    (if (tblsearch "layer" name)
        (command "_.LAYER" "_ON" name "_THAW" name "_UNLOCK" name "")
        (command "_.LAYER" "_NEW" name ""))
    (setvar "CLAYER" name)
)

;;; ---------------------------------------------------------------------------
;;; SPIRAL
;;;
;;; An Archimedean spiral: the radius grows in direct proportion to the angle
;;; turned, which is what makes the gap between successive turns constant. That
;;; constant gap is exactly the "growth per rotation" asked for, so a coil drawn
;;; at growth 2 has its turns 2 apart all the way out.
;;;
;;;     r(theta) = growth x (theta / 2*pi)
;;;
;;; Drawn as a polyline through points sampled around the turn. More points per
;;; rotation gives a smoother curve at the cost of a heavier object; 36 - one
;;; point every 10 degrees - is smooth enough at any normal plot scale.
;;; ---------------------------------------------------------------------------

(defun c:SPIRAL ( / vals *error* cen turns growth segs total i ang r pt )

    (setq vals (ShopShapes:Save))
    (defun *error* ( msg )
        (ShopShapes:Restore vals)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** SPIRAL 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. The declaring call is absent on older
    ;; releases, so it is wrapped rather than tested for.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")
    (setvar "BLIPMODE" 0)

    (setq cen (getpoint "\nCentre of the spiral: "))

    (if (null cen)
        (princ "\nCancelled.")
        (progn
            (setq turns  (ShopShapes:AskInt  "TURNS"  "Number of rotations")
                  growth (ShopShapes:AskDist "GROWTH" "Growth per rotation")
                  segs   (ShopShapes:AskInt  "SEGS"   "Points per rotation"))

            (setvar "OSMODE" 0)
            (ShopShapes:Layer "SHOPSHAPES")

            ;; One extra point so the last turn actually closes on its end angle
            ;; rather than stopping one step short of it.
            (setq total (* turns segs) i 0)

            (command "_.PLINE")
            (while (<= i total)
                (setq ang (/ (* 2.0 pi i) segs)      ; angle turned so far
                      r   (* growth (/ ang (* 2.0 pi)))
                      pt  (polar cen ang r))
                (command pt)
                (setq i (1+ i)))
            (command "")

            (princ (strcat "\nSpiral drawn - " (itoa turns) " turns, final radius "
                           (rtos (* growth turns) 2 4) "."))))

    (ShopShapes:Restore vals)
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; SLOT
;;;
;;; Built as a single closed polyline with two 180 degree bulges rather than as
;;; four separate objects. A bulge is the tangent of a quarter of the included
;;; angle, so a half circle is tan(45) = 1, negative for a clockwise sweep.
;;;
;;; Length is measured CENTRE TO CENTRE of the two end radii, which is how a
;;; slot is dimensioned and machined. Overall length is that plus twice the
;;; radius, and the routine reports both so there is no ambiguity.
;;; ---------------------------------------------------------------------------

(defun c:SLOT ( / vals *error* base rad len ang c1 c2 lft rgt p1 p2 p3 p4 )

    (setq vals (ShopShapes:Save))
    (defun *error* ( msg )
        (ShopShapes:Restore vals)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** SLOT 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. The declaring call is absent on older
    ;; releases, so it is wrapped rather than tested for.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")
    (setvar "BLIPMODE" 0)

    (setq base (getpoint "\nCentre of the first end radius: "))

    (if (null base)
        (princ "\nCancelled.")
        (progn
            (setq rad (ShopShapes:AskDist "SLOTRAD" "End radius")
                  len (ShopShapes:AskDist "SLOTLEN" "Length, centre to centre"))
            (setq ang (getangle base "\nAngle of the slot <0>: "))
            (if (null ang) (setq ang 0.0))

            (setvar "OSMODE" 0)
            (ShopShapes:Layer "SHOPSHAPES")

            (setq c1  base
                  c2  (polar base ang len)
                  lft (+ ang (* pi 0.5))
                  rgt (- ang (* pi 0.5))
                  p1  (polar c1 lft rad)
                  p2  (polar c2 lft rad)
                  p3  (polar c2 rgt rad)
                  p4  (polar c1 rgt rad))

            ;; 70 bit 1 = closed. The two -1 bulges are the end radii, swept
            ;; clockwise so each wraps round the OUTSIDE of its own centre.
            (entmake
                (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity")
                      (cons 8 (getvar "CLAYER"))
                      '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)
                      (cons 10 (list (car p1) (cadr p1))) '(42 . 0.0)
                      (cons 10 (list (car p2) (cadr p2))) '(42 . -1.0)
                      (cons 10 (list (car p3) (cadr p3))) '(42 . 0.0)
                      (cons 10 (list (car p4) (cadr p4))) '(42 . -1.0)))

            (princ (strcat "\nSlot drawn - " (rtos len 2 4) " centres, "
                           (rtos (+ len (* 2.0 rad)) 2 4) " overall, "
                           (rtos (* 2.0 rad) 2 4) " wide."))))

    (ShopShapes:Restore vals)
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; FLANGE
;;;
;;; Outside diameter, bore, bolt circle and the bolt holes themselves.
;;;
;;; The bolt circle is drawn on its own layer in CENTER linetype, because it is a
;;; setting-out line rather than an edge of the part - drawn continuous it reads
;;; as a machined step that is not there.
;;;
;;; Holes are placed by direct calculation rather than by ARRAY. The routine this
;;; replaces arrayed the last entity, which silently picked up whatever else had
;;; just been drawn if anything went wrong, and could not cope with a hole count
;;; that did not divide evenly.
;;; ---------------------------------------------------------------------------

(defun c:FLANGE ( / vals *error* cen od id bc hole n start i ang )

    (setq vals (ShopShapes:Save))
    (defun *error* ( msg )
        (ShopShapes:Restore vals)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** FLANGE 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. The declaring call is absent on older
    ;; releases, so it is wrapped rather than tested for.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")
    (setvar "BLIPMODE" 0)

    (setq cen (getpoint "\nCentre of the flange: "))

    (if (null cen)
        (princ "\nCancelled.")
        (progn
            (setq od (ShopShapes:AskDist "OD" "Outside radius"))

            ;; Each value is checked against the ones already given, and the
            ;; prompt simply repeats until it is consistent.
            (setq id nil)
            (while (null id)
                (setq id (ShopShapes:AskDist "ID" "Bore radius"))
                (if (>= id od)
                    (progn (princ "\nThe bore must be smaller than the outside radius.")
                           (setq id nil))))

            (setq bc nil)
            (while (null bc)
                (setq bc (ShopShapes:AskDist "BC" "Bolt circle radius"))
                (cond
                    ((>= bc od) (princ "\nThe bolt circle must be inside the outside radius.")
                                (setq bc nil))
                    ((<= bc id) (princ "\nThe bolt circle must be outside the bore.")
                                (setq bc nil))))

            (setq hole (ShopShapes:AskDist "HOLE"   "Bolt hole diameter")
                  n    (ShopShapes:AskInt  "NHOLES" "Number of bolt holes"))

            (setq start (getangle cen "\nAngle to the first hole <0>: "))
            (if (null start) (setq start 0.0))

            (setvar "OSMODE" 0)

            (ShopShapes:Layer "SHOPSHAPES")
            (command "_.CIRCLE" cen od)
            (command "_.CIRCLE" cen id)

            ;; Bolt circle as a setting-out line.
            (if (not (tblsearch "ltype" "CENTER"))
                (vl-catch-all-apply
                    '(lambda ( ) (command "_.-LINETYPE" "_Load" "CENTER" "acad.lin" ""))))
            (ShopShapes:Layer "SHOPSHAPES-CENTRE")
            (if (tblsearch "ltype" "CENTER")
                (command "_.LAYER" "_LTYPE" "CENTER" "SHOPSHAPES-CENTRE" ""))
            (command "_.CIRCLE" cen bc)

            ;; The holes, stepped evenly round from the start angle.
            (ShopShapes:Layer "SHOPSHAPES")
            (setq i 0)
            (repeat n
                (setq ang (+ start (/ (* 2.0 pi i) n)))
                (command "_.CIRCLE" (polar cen ang bc) (/ hole 2.0))
                (setq i (1+ i)))

            (princ (strcat "\nFlange drawn - " (rtos (* od 2.0) 2 3) " over, "
                           (rtos (* id 2.0) 2 3) " bore, " (itoa n)
                           " holes on a " (rtos (* bc 2.0) 2 3) " bolt circle."))))

    (ShopShapes:Restore vals)
    (princ)
)

(princ)