;ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
;º   3DSpiral.Lsp            Version 1.3                Sep 24, 1994   º
;º   Construct A 3D Spiral Using 3D Polyline                           º
;ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
;================== Start Program ======================================
(prompt "\nLoading 3DSpirail v1.3  ")          ;Display Loader
(setq 3DSpiral nil sp_c 1)                     ;Reset Program Name
;%%%%%%%%%%%%%%%%%% Macros %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
(defun PDot ()(princ "."))                     ;Print Dot
(defun Spin ()                                 ;Spinning
  (setq sp_c (1+ sp_c))                        ;Dashes
  (write-char '8)                              ;For Display
  (princ (nth (rem sp_c 4) (list "|" "/" "-" "\\"))))
(defun BkSp () (write-char '8))                ;Define Back Space
(defun Beep (/ f) (setq f (open "con" "w"))    ;Print Hex 7
      (write-char '7 f) (close f))             ;To CON
(defun Err (e) (beep)                          ;Error Out
               (princ (strcat "\nError: " e))
               (quit))
(defun C:UB () (command "UNDO" "BACK") (redraw) (prin1))
(defun PtoS (p / tpt)                         ;Convert Point To String
 (if (= 'LIST (type p))                       ;If Augment Type A List
     (progn                                   ;Add Each Atom
      (setq tpt (rtos (car p) 2 4) p (cdr p)) ;To String
      (foreach x p (setq tpt (strcat tpt "," (rtos x 2 4)))))))

;%%%%%%%%%%%%%%%%%% Sub Routines %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
(PDot);++++++++++++ Set Modes & Error ++++++++++++++++++++++++++++++++++
;Mode Variables  m_l SetList  m_s NewSetting  m_n OldName  m_v OldValue
 (defun 3d_smd ()                              ;Define 3d_smd
  (command "UNDO" "MARK")                      ;Set An Undo Mark
  (setq m_v nil m_n nil                        ;Reset Name & Value
        m_l (list "CMDECHO" "BLIPMODE" "HIGHLIGHT" "OSMODE")
        m_s (list 0 0 1 0)                     ;Setup Modes
     olderr *error*                            ;Get Old Error
    *error* (lambda (s)                        ;Set Error So That
     (cond ((= s "Function cancelled"))        ;If Cancel Or
           ((= s "quit / exit abort"))         ;Abort Exit Clean
           ((princ (strcat "\nError: " s))))   ;Else Print Error
     (3d_rmd)))                                ;Return Modes
  (foreach x m_l (setq m_v (cons (getvar x) m_v);Get Value
                       m_n (cons x m_n)))      ;And Variable
  (mapcar 'setvar m_l m_s))                    ;Set New Modes
(PDot);++++++++++++ Return Modes & Error +++++++++++++++++++++++++++++++
 (defun 3d_rmd ()                              ;Define 3d_rmd
  (setq *error* olderr)                        ;Reset Error
  (mapcar 'setvar m_n m_v)                     ;Reset Modes
  (prin1))                                     ;Exit Clean

(PDot);************ Main Program ***************************************
(defun 3dspiral (/ nang ctr dia red trd sec rev npt base elev ang nang)
  (3d_smd)                                     ;Set Modes
; (setq *error* nil)                           ;Debugging Aid
;------------ Get User Input -------------------------------------------
(initget 1)                                    ;Force Input
(setq ctr (getpoint "\nCenter Of Spiral:.... "))
(setq rad (getdist ctr "\nSpiral Radius:... "))
(setq trd (getreal "\nRevolutions Per Inch:... "))
(setq rev (getreal "\nNumber of Revolutions To Draw <1>:... "))
(setq sec (getint "\nNumber Of Sections Per Revolution <36>:... "))
;------------ Set Constants --------------------------------------------
(if (= sec nil)(setq sec 36))                  ;Default To 36 Sections
(if (= rev nil)(setq rev 1))                   ;Default To 1 Revolution
(setq dia (* rad 2)                            ;Calculate Diameter
     base (caddr ctr)                          ;Base = Center Elevation
      ris (/ 1.0 trd)                          ;Get Rise Per Turn
      ang (/ 360.0 sec))                       ;Get Angle Per Section
;------------ Setup First Line -----------------------------------------
(setq pt1 (list                                ;Assemble Point1
             (+ (car ctr) rad)                 ;X = CenterX + Radius
             (cadr ctr)                        ;Y = CenterY
             base)                             ;Z = Base Elevation
     elev (+ base (/ ris sec))                 ;Add Rise To Base
     nang (/ 360.0 sec)                        ;Get Next Angle
      npt (polar ctr (* pi (/ nang 180)) rad)  ;Calculate Next Point
      pt2 (list (car npt) (cadr npt) elev))    ;Assemble Point2
;------------ Setup Script File ----------------------------------------
   (setq wfile (open "SPIRAL.SCR" "w"))        ;Open Script File
   (write-line "(3d_smd)" wfile)               ;Set Modes
   (write-line "3DPOLY" wfile)                 ;3DPoly Command
   (setq spt (ptos pt1))                       ;Set First Point
   (write-line spt wfile)                      ;Write 1st Point To File
   (setq spt (ptos pt2))                       ;Set Second Point
   (princ "\nCalculating Elevation:\n")        ;Display Status
;------------ Calculate Remaining Lines --------------------------------
(repeat (fix (* sec rev))                      ;Repeat Total Sections
 (repeat 12 (bksp))                            ;Clear Command Line
 (princ (rtos elev 2 4))                       ;Display Elevation
 (write-line spt wfile)                        ;Write Remaining Points
 (setq nang (+ nang ang)                       ;Get Next Angle
       pt1 (getvar "lastpoint")                ;Set Point1 Last Point
       elev (+ elev (/ ris sec))               ;Add Rise To Elevation
       npt (polar ctr (* pi (/ nang 180)) rad) ;Calculate Next Point
       pt2 (list (car npt) (cadr npt) elev)    ;Assemble Point2
       spt (ptos pt2)))                        ;Set Next Point
;------------ Run Script File ------------------------------------------
  (write-line "" wfile)                        ;Issue A Return
  (write-line "(3d_rmd)" wfile)                ;Return Modes
  (close wfile)                                ;Close File
  (command "SCRIPT" "SPIRAL")                  ;Run Script
 (3d_rmd))                                     ;Return Modes & Error

(PDot);@@@@@@@@@@@@ Load Program @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 (defun C:3DSpiral () (3DSpiral))              ;Make Command Resident
 (if 3DSpiral (princ "\n3DSpiral Defined\n"))  ;Confirm Loading
 (prin1)                                       ;Else Display Errors
;ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ End Program ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ