;ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» ;º 3DScrew.Lsp Version 1.2 Sep 24, 1994 º ;º Draw A 3D Screw Tread º ;ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ ;================== Start Program ====================================== (princ "\nLoading 3DScrew v1.2 ") ;Program Loader (setq 3DScrew 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)) ;Back Space (defun AtoR (a) (* pi (/ a 180.0))) ;Angle To Radian (defun RtoA (r) (/ (* r 180.0) pi)) ;Radian To Angle (defun Beep (/ f) (setq f (open "con" "w")) ;Print Hex 7 (write-char '7 f) (close f)) ;To CON (defun Err (e) (beep) ;Augmented (princ (strcat "\nError: " e)) ;Error (quit)) ;Routine ;%%%%%%%%%%%%%%%%%% Sub Routines %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% (PDot);++++++++++++ Set Modes & Error ++++++++++++++++++++++++++++++++++ ;Mode Variables m_l SetList m_s NewSetting m_n OldName m_v OldValue (defun st_smd () ;Define st_smd (command "UNDO" "MARK") ;Set An Undo Mark (setq m_v nil m_n nil ;Reset Name & Value m_l (list "CMDECHO" "BLIPMODE" "HIGHLIGHT" "SPLFRAME") 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 (st_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 st_rmd () ;Define st_rmd (setq *error* olderr) ;Reset Error (mapcar 'setvar m_n m_v) ;Reset Modes (prin1)) ;Exit Clean (PDot);************ Main Program *************************************** (defun 3dscrew (/ nang elv ctr dia dis ang rad trd sec ris base rev p2 p3 pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 m_n m_v m_s m_l olderr) (st_smd) ;------------ Get User Input ------------------------------------------- (setq ctr (getpoint "\nCenter Of Screw:.... ")) (setq dia (getreal "\nOutside Screw Diameter:... ")) (setq trd (getreal "\nNumber Of Threads Per Inch:... ")) (setq tag (getangle "\nThread Cut Angle:... ")) (setq sec (getint "\nEnter Number Of Sections To Draw Per Thread:... ")) (setq rev (getreal "\nNumber of Threads To Draw <1>:... ")) ;------------ Set Constants -------------------------------------------- (if (= rev nil)(setq rev 1)) ;Default To 1 Revolution (setq rad (* dia 0.5)) ;Calculate Radius (setq base (caddr ctr)) ;Set Base Elevation (setq old base) ;Set Last Elevation (setq ris (/ 1.0 trd)) ;Calculate Rise Per Thread (setq elev (+ base (/ ris sec))) ;Next Elevation (setq ang (/ 360.0 sec)) ;Angle Per Section (setq nang (/ 360.0 sec)) ;Next Angle (setq ird (- rad (/ (* ris 0.5) ;Get Inside Radius (/ (sin tag) (cos tag))))) ;As A Percentage (setq irad (/ ird rad)) ;Of Outside Radius ;------------ Setup First Segment -------------------------------------- (setq pt1 (list (+ (car ctr) rad) (cadr ctr) base)) ;Set Point1 (setq pt4 (list (* irad (car pt1)) ;Set Point4 (* irad (cadr pt1)) (+ base (* 0.5 ris)))) (setq p2 (polar ctr (* pi (/ nang 180)) rad)) ;Calculate XY2 (setq p3 (polar ctr (* pi (/ nang 180)) (* rad irad))) ;Calculate XY3 (setq pt2 (list (car p2) (cadr p2) (+ base (/ ris sec))));Set Point2 (setq pt3 (list (car p3) (cadr p3) (+ old (* 0.5 ris)))) ;Set Point3 (setq pt5 (list (car pt1) (cadr pt1) (+ base ris))) ;Set Point5 (setq pt6 (list (car pt2) (cadr pt2) (+ elev ris))) ;Set Point6 (setq pt7 (list (car ctr) (cadr ctr) (+ elev ris))) ;Set Point7 (setq pt8 (list (car ctr) (cadr ctr) (+ base ris))) ;Set Point8 ;------------ Draw Segments -------------------------------------------- (repeat (fix (* sec rev)) ;Draw (command "3DFACE" pt1 pt2 ;Visible pt3 pt4 ;Thread pt5 pt6 "") ;Faces (command "3DFACE" "I" pt5 ;And "I" pt6 ;Hidden "I" pt7 ;Inner "I" pt8 "") ;Faces ;------------ Setup Next Segment --------------------------------------- (setq nang (+ nang ang)) ;Increase Angle (setq pt1 (list (car pt2) (cadr pt2) elev)) ;Set Point1 (setq pt4 (list (car pt3) (cadr pt3) (+ old (* 0.5 ris))));Set Point4 (prompt (strcat "\nWorking On Elevation: " (rtos elev 2 4))) (setq old elev) ;Last Elev (setq elev (+ elev (/ ris sec))) ;Outside Elev (setq inelev (+ elev (* 0.5 ris))) ;Inside Elev (setq p2 (polar ctr (* pi (/ nang 180)) rad)) ;Calculate XY2 (setq p3 (polar ctr (* pi (/ nang 180)) (* rad irad))) ;Calculate XY3 (setq pt2 (list (car p2) (cadr p2) elev)) ;Set Point2 (setq pt3 (list (car p3) (cadr p3) (+ old (* 0.5 ris))));Set Point3 (setq pt5 (list (car pt1) (cadr pt1) (+ old ris))) ;Set Point5 (setq pt6 (list (car pt2) (cadr pt2) (+ elev ris))) ;Set Point6 (setq pt7 (list (car ctr) (cadr ctr) (+ elev ris))) ;Set Point7 (setq pt8 (list (car ctr) (cadr ctr) (+ old ris))) ;Set Point8 ) ;End Repeat (st_rmd)) ;Return Modes (PDot);@@@@@@@@@@@@ Load Program @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ (defun C:3DScrew () (3DScrew)) ;Make Command (and 3DScrew ;Resident (repeat 25 (BkSp)) ;Confirm (prompt "3DScrew Defined \n")) ;Loading (prin1) ;Else Display Errors ;ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ End Program ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ