Cadastrophic
25th Apr 2005, 11:49 pm
Would one of you who has experience with lisp routines mind casting an eye over this lisp for me please? The author didn't include his email address, so I can't contact him.
The problem is, I need to load the lisp afresh every time I want to use it. For some reason it unloads itself.
It also switches off all my OSNAPS and the routine doesn't seem to fully complete.
Maybe I'm doing something wrong.
;;;DJG_RCSprockets.lsp Sprocket Drafting Utility (c) 2005 Don Grauel
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;
;;;
;;; Filename: DJG_RCSprockets.lsp
;;; Author: Don Grauel
;;; First created: 11/22/99
;;; Last updated: 02/03/05
;;; Description: This function automates the creation of roller chain sprockets.
;;;
;;; References: ASME B29.1M-1993
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;
(defun c:DJG_RCS (/ +*error* +attdia +attreq +blipmode +clayer +cmdecho +dimzin +osmode
txt tmp waiting N P Dr PD OD Ds R A B M U E W V F
pta ptb ptc pt00 pt01 pt02 pt03 pt04 pt05 pt06 pt07 pt08
circle_R circle_F circle_E circle_OD line_01 line_02 pline_01 pline_02 ss01)
(DJG_InitEnv)
(prompt "\nRoller Chain Sprocket Generator...")
(if (not DJG_RCS-chn) (setq DJG_RCS-chn "160")) ; set default, suggesting previous value if it exists
(setq txt (strcat "\nChain Number [25/35/41/40/50/60/80/100/120/140/160/180/200/240] <" DJG_RCS-chn ">: "))
(initget "25 35 41 40 50 60 80 100 120 140 160 180 200 240")
(setq tmp (getkword txt))
(if (/= tmp nil) (setq DJG_RCS-chn tmp))
(setvar "dimzin" 8) ; suppress trailing zeros in default value prompt
(if (not DJG_RCS-N) (setq DJG_RCS-N 12))
(setq txt (strcat "\nNumber of teeth <" (rtos DJG_RCS-N) ">: "))
(setq waiting T)
(while waiting
(initget 6)
(setq tmp (getint txt))
(cond ( (= tmp nil) ; user accepted default value
(setq N DJG_RCS-N waiting nil)
)
( (< 4 tmp 201) ; user provided valid input
(setq DJG_RCS-N tmp N tmp waiting nil)
)
( T
(prompt "\nValue must be between 5 and 200 inclusive.")
)
)
)
(if (not DJG_RCS-frm) (setq DJG_RCS-frm "N"))
(setq txt (strcat "\nUse pointed-tooth form? [Y/N] <" DJG_RCS-frm ">: "))
(initget "Y N")
(setq tmp (getkword txt))
(if (/= tmp nil) (setq DJG_RCS-frm tmp))
(if (not DJG_RCS-ipt) (setq DJG_RCS-ipt '(0 0)))
(setq txt (strcat "(" (rtos (car DJG_RCS-ipt)) "," (rtos (cadr DJG_RCS-ipt)) ")")
txt (strcat "\nSprocket center point <" txt ">: ")
)
(initget 0)
(setq tmp (getpoint txt))
(if (/= tmp nil)
(setq DJG_RCS-ipt (list (car tmp) (cadr tmp)) ; discarding z-coordinate from (getpoint)
pt00 DJG_RCS-ipt
)
(setq pt00 DJG_RCS-ipt)
)
(cond ( (= DJG_RCS-chn "25")
(setq P 0.25 ; chain pitch
Dr 0.13 ; roller diameter
)
)
( (= DJG_RCS-chn "35")
(setq P 0.375
Dr 0.2
)
)
( (= DJG_RCS-chn "41")
(setq P 0.5
Dr 0.306
)
)
( (= DJG_RCS-chn "40")
(setq P 0.5
Dr 0.312
)
)
( (= DJG_RCS-chn "50")
(setq P 0.625
Dr 0.4
)
)
( (= DJG_RCS-chn "60")
(setq P 0.75
Dr 0.469
)
)
( (= DJG_RCS-chn "80")
(setq P 1.0
Dr 0.625
)
)
( (= DJG_RCS-chn "100")
(setq P 1.25
Dr 0.75
)
)
( (= DJG_RCS-chn "120")
(setq P 1.5
Dr 0.875
)
)
( (= DJG_RCS-chn "140")
(setq P 1.75
Dr 1.0
)
)
( (= DJG_RCS-chn "160")
(setq P 2.0
Dr 1.125
)
)
( (= DJG_RCS-chn "180")
(setq P 2.25
Dr 1.406
)
)
( (= DJG_RCS-chn "200")
(setq P 2.5
Dr 1.562
)
)
( (= DJG_RCS-chn "240")
(setq P 3.0
Dr 1.875
)
)
)
; converting to radians when using AutoLISP trig functions
(setq PD (/ P (sin (/ pi N))) ; pitch diameter
OD (* P (+ 0.6 (/ (cos (/ pi N)) (sin (/ pi N))))) ; outside diameter (using cot=cos/sin identity)
Ds (+ (* 1.005 Dr) 0.003) ; seating curve diameter
R (/ Ds 2.0) ; seating curve radius
A (+ 35 (/ 60.0 N)) ; [degrees]
B (- 18 (/ 56.0 N)) ; [degrees]
M (* 0.8 Dr (cos (d2r A)))
U (* 0.8 Dr (sin (d2r A))) ; using U in place of T to avoid overwriting AutoCAD symbol T
E (+ (* 1.3025 Dr) 0.0015)
W (* 1.4 Dr (cos (/ pi N)))
V (* 1.4 Dr (sin (/ pi N)))
F (- (* Dr
(+ (* 0.8 (cos (d2r B)))
(* 1.4 (cos (d2r (- 17 (/ 64.0 N)))))
-1.3025
)
)
0.0015
)
)
(setq pta (list (car pt00) (+ (cadr pt00) (/ PD 2))) ; center of arc w/radius R (seating curve)
ptb (list (+ (car pta) W) (- (cadr pta) V)) ; center of arc w/radius F
ptc (list (- (car pta) M) (+ (cadr pta) U)) ; center of arc w/radius E
pt01 (list (car pta) (+ (cadr pta) Ds))
pt02 (polar pt00
(- (/ pi 2) (/ pi N))
(+ (/ PD 2) Ds)
)
pt03 (polar ptc (d2r 285) E)
pt04 (polar ptb (d2r 105) F)
pt05 (polar ptb (d2r 270) F)
pt06 (polar ptb (d2r 60) F)
pt07 (polar pta (d2r 150) R)
pt08 (polar pt02
(- (* pi 1.5) (/ pi N))
(* Ds 1.25)
)
)
(command "zoom" "c" pta (* 4 Ds))
(DJG_LayerSet "-Visible" "4" "Continuous")
(setvar "osmode" 0)
(command "circle" pta R) ; draw circle w/radius R (seating curve)
(setq circle_R (entlast))
(command "circle" ptb F) ; draw circle w/radius F
(setq circle_F (entlast))
(command "circle" ptc E) ; draw circle w/radius E
(setq circle_E (entlast))
(setvar "osmode" 256) ; tangent osnap
(command "line" pt03 pt04 "") ; draw line tangent to circles of radii E & F
(setq line_01 (entlast))
(setvar "osmode" 0)
(command "trim" line_01 circle_R "" pt03 "") ; trim circle of radius E
(if (= DJG_RCS-frm "Y")
(progn
(command "line" pt02 pt08 "") ; draw tooth centerline
(setq line_02 (entlast))
(command "trim" line_01 line_02 "" pt05 "") ; trim circle of radius F
(command "erase" line_02 "")
)
(progn
(command "circle" pt00 "d" OD) ; draw sprocket OD
(setq circle_OD (entlast))
(command "trim" line_01 circle_OD "" pt05 pt06 "") ; trim circle of radius F
(command "mirror" circle_F "" pt00 pt02 "") ; arc temporarily needed to trim sprocket OD
(setq tmp (entlast))
(command "trim" circle_F tmp "" circle_OD "") ; trim sprocket OD
(command "erase" tmp "") ; erase temporary arc
)
)
(if (= (getvar "peditaccept") 1)
(command "pedit" circle_E "j" line_01 circle_F "" "")
(command "pedit" circle_E "y" "j" line_01 circle_F "" "")
)
(setq pline_01 (entlast))
(command "mirror" pline_01 "" pt00 pt01 "")
(setq pline_02 (entlast))
(command "trim" pline_01 pline_02 "" pt07 "") ; trim circle of radius R
(if (= DJG_RCS-frm "Y")
(command "pedit" pline_01 "j" pline_02 circle_R "" "")
(command "pedit" pline_01 "j" pline_02 circle_R circle_OD "" "")
)
(setq pline_01 (entlast))
(command "zoom" "c" pt00 PD)
(command "zoom" ".75x")
(command "array" pline_01 "" "p" pt00 N "" "")
(setq tmp pline_01
ss01 (ssadd) ; initialize ss01 to null selection set
)
(repeat (- N 1)
(ssadd (setq tmp (entnext tmp)) ss01) ; add each polyline created by array command to selection set
)
(command "pedit" pline_01 "j" ss01 "" "")
(command "rotate" pline_01 "" pt00 (/ 180.0 N)) ; rotate sprocket profile so that tooth is at 90°
(DJG_LayerSet "-Center" "5" "Center")
(command "circle" pt00 "d" PD) ; draw sprocket pitch circle
(DJG_ResetEnv)
(princ)
) ;_c:DJG_RCS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;
(defun d2r (a) (* (/ a 180.0) pi)) ; convert from degrees to radians
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;
(defun DJG_InitEnv ()
;;
;; Author: Don Grauel
;; First created: 12/02/04
;; Last updated: 01/178/05
;; Description: This function is used to initialize environment prior to running many custom routines.
;;
;;;;;;;;;;;;;;;;;;;;
(setq +*error* *error*
*error* *DJG_Error01*
+attdia (getvar "attdia")
+attreq (getvar "attreq")
+blipmode (getvar "blipmode")
+clayer (getvar "clayer")
+cmdecho (getvar "cmdecho")
+dimzin (getvar "dimzin")
+osmode (getvar "osmode")
)
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(command "undo" "mark")
(princ)
) ;_ DJG_InitEnv
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;
(defun DJG_ResetEnv ()
;;
;; Author: Don Grauel
;; First created: 12/02/04
;; Last updated: 01/17/05
;; Description: This function is used to reset environment after running many custom routines.
;;
;;;;;;;;;;;;;;;;;;;;
(setq *error* +*error*)
(setvar "attdia" +attdia)
(setvar "attreq" +attreq)
(setvar "blipmode" +blipmode)
(setvar "clayer" +clayer)
(setvar "cmdecho" +cmdecho)
(setvar "dimzin" +dimzin)
(setvar "osmode" +osmode)
(princ)
) ;_ DJG_ResetEnv
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;
(defun *DJG_Error01* (msg) ; custom error handler
(command) ; exit from any active commands
(command)
(command)
(command "undo" "back")
(if (or (= msg "Function cancelled")
(= msg "quit / exit abort")
)
(princ)
(princ (strcat "\nError: " msg))
)
(setq *error* +*error*)
(setvar "attdia" +attdia)
(setvar "attreq" +attreq)
(setvar "blipmode" +blipmode)
(setvar "clayer" +clayer)
(setvar "dimzin" +dimzin)
(setvar "osmode" +osmode)
(setvar "cmdecho" 0)
(command "undo" "mark")
(setvar "cmdecho" +cmdecho)
) ;_ *DJG_Error01*
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;
(defun DJG_LayerSet (layname laycolor lintype / tblentry laystate tmp)
;;
;; Author: Don Grauel
;; First created: 12/02/04
;; Last updated: 01/28/05
;; Description: This function sets the specified layer current, creating it if it doesn't already exist.
;;
;;;;;;;;;;;;;;;;;;;;
(setq tblentry (tblsearch "LAYER" layname)
laystate 0
)
(if tblentry
(progn
(if (/= (logand (cdr (assoc 70 tblentry)) 1) 0) ; bitcode of 1 indicates layer is frozen
(setq laystate (+ laystate 1))
)
(if (/= (logand (cdr (assoc 70 tblentry)) 4) 0) ; bitcode of 4 indicates layer is locked
(setq laystate (+ laystate 2))
)
(if (< (cdr (assoc 62 tblentry)) 0) ; color number is negative when layer is turned off
(setq laystate (+ laystate 4))
)
(command "layer" "thaw" layname "unlock" layname "on" layname "set" layname "")
)
(progn
(command "layer" "make" layname "color" laycolor "" "ltype" lintype "" "")
(setq laystate 8)
)
)
(setq tmp (strcat "\nLayer \"" layname "\" has been "))
(cond ( (= laystate 1)
(setq tmp (strcat tmp "thawed."))
)
( (= laystate 2)
(setq tmp (strcat tmp "unlocked."))
)
( (= laystate 3)
(setq tmp (strcat tmp "thawed and unlocked."))
)
( (= laystate 4)
(setq tmp (strcat tmp "turned on."))
)
( (= laystate 5)
(setq tmp (strcat tmp "thawed and turned on."))
)
( (= laystate 6)
(setq tmp (strcat tmp "unlocked and turned on."))
)
( (= laystate 7)
(setq tmp (strcat tmp "thawed, unlocked, and turned on."))
)
( (= laystate 8)
(setq tmp (strcat tmp "created."))
)
)
(if (> laystate 0) (prompt tmp))
(command "color" "bylayer")
(princ)
) ;_ DJG_LayerSet
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;
(princ)
The problem is, I need to load the lisp afresh every time I want to use it. For some reason it unloads itself.
It also switches off all my OSNAPS and the routine doesn't seem to fully complete.
Maybe I'm doing something wrong.
;;;DJG_RCSprockets.lsp Sprocket Drafting Utility (c) 2005 Don Grauel
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;
;;;
;;; Filename: DJG_RCSprockets.lsp
;;; Author: Don Grauel
;;; First created: 11/22/99
;;; Last updated: 02/03/05
;;; Description: This function automates the creation of roller chain sprockets.
;;;
;;; References: ASME B29.1M-1993
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;
(defun c:DJG_RCS (/ +*error* +attdia +attreq +blipmode +clayer +cmdecho +dimzin +osmode
txt tmp waiting N P Dr PD OD Ds R A B M U E W V F
pta ptb ptc pt00 pt01 pt02 pt03 pt04 pt05 pt06 pt07 pt08
circle_R circle_F circle_E circle_OD line_01 line_02 pline_01 pline_02 ss01)
(DJG_InitEnv)
(prompt "\nRoller Chain Sprocket Generator...")
(if (not DJG_RCS-chn) (setq DJG_RCS-chn "160")) ; set default, suggesting previous value if it exists
(setq txt (strcat "\nChain Number [25/35/41/40/50/60/80/100/120/140/160/180/200/240] <" DJG_RCS-chn ">: "))
(initget "25 35 41 40 50 60 80 100 120 140 160 180 200 240")
(setq tmp (getkword txt))
(if (/= tmp nil) (setq DJG_RCS-chn tmp))
(setvar "dimzin" 8) ; suppress trailing zeros in default value prompt
(if (not DJG_RCS-N) (setq DJG_RCS-N 12))
(setq txt (strcat "\nNumber of teeth <" (rtos DJG_RCS-N) ">: "))
(setq waiting T)
(while waiting
(initget 6)
(setq tmp (getint txt))
(cond ( (= tmp nil) ; user accepted default value
(setq N DJG_RCS-N waiting nil)
)
( (< 4 tmp 201) ; user provided valid input
(setq DJG_RCS-N tmp N tmp waiting nil)
)
( T
(prompt "\nValue must be between 5 and 200 inclusive.")
)
)
)
(if (not DJG_RCS-frm) (setq DJG_RCS-frm "N"))
(setq txt (strcat "\nUse pointed-tooth form? [Y/N] <" DJG_RCS-frm ">: "))
(initget "Y N")
(setq tmp (getkword txt))
(if (/= tmp nil) (setq DJG_RCS-frm tmp))
(if (not DJG_RCS-ipt) (setq DJG_RCS-ipt '(0 0)))
(setq txt (strcat "(" (rtos (car DJG_RCS-ipt)) "," (rtos (cadr DJG_RCS-ipt)) ")")
txt (strcat "\nSprocket center point <" txt ">: ")
)
(initget 0)
(setq tmp (getpoint txt))
(if (/= tmp nil)
(setq DJG_RCS-ipt (list (car tmp) (cadr tmp)) ; discarding z-coordinate from (getpoint)
pt00 DJG_RCS-ipt
)
(setq pt00 DJG_RCS-ipt)
)
(cond ( (= DJG_RCS-chn "25")
(setq P 0.25 ; chain pitch
Dr 0.13 ; roller diameter
)
)
( (= DJG_RCS-chn "35")
(setq P 0.375
Dr 0.2
)
)
( (= DJG_RCS-chn "41")
(setq P 0.5
Dr 0.306
)
)
( (= DJG_RCS-chn "40")
(setq P 0.5
Dr 0.312
)
)
( (= DJG_RCS-chn "50")
(setq P 0.625
Dr 0.4
)
)
( (= DJG_RCS-chn "60")
(setq P 0.75
Dr 0.469
)
)
( (= DJG_RCS-chn "80")
(setq P 1.0
Dr 0.625
)
)
( (= DJG_RCS-chn "100")
(setq P 1.25
Dr 0.75
)
)
( (= DJG_RCS-chn "120")
(setq P 1.5
Dr 0.875
)
)
( (= DJG_RCS-chn "140")
(setq P 1.75
Dr 1.0
)
)
( (= DJG_RCS-chn "160")
(setq P 2.0
Dr 1.125
)
)
( (= DJG_RCS-chn "180")
(setq P 2.25
Dr 1.406
)
)
( (= DJG_RCS-chn "200")
(setq P 2.5
Dr 1.562
)
)
( (= DJG_RCS-chn "240")
(setq P 3.0
Dr 1.875
)
)
)
; converting to radians when using AutoLISP trig functions
(setq PD (/ P (sin (/ pi N))) ; pitch diameter
OD (* P (+ 0.6 (/ (cos (/ pi N)) (sin (/ pi N))))) ; outside diameter (using cot=cos/sin identity)
Ds (+ (* 1.005 Dr) 0.003) ; seating curve diameter
R (/ Ds 2.0) ; seating curve radius
A (+ 35 (/ 60.0 N)) ; [degrees]
B (- 18 (/ 56.0 N)) ; [degrees]
M (* 0.8 Dr (cos (d2r A)))
U (* 0.8 Dr (sin (d2r A))) ; using U in place of T to avoid overwriting AutoCAD symbol T
E (+ (* 1.3025 Dr) 0.0015)
W (* 1.4 Dr (cos (/ pi N)))
V (* 1.4 Dr (sin (/ pi N)))
F (- (* Dr
(+ (* 0.8 (cos (d2r B)))
(* 1.4 (cos (d2r (- 17 (/ 64.0 N)))))
-1.3025
)
)
0.0015
)
)
(setq pta (list (car pt00) (+ (cadr pt00) (/ PD 2))) ; center of arc w/radius R (seating curve)
ptb (list (+ (car pta) W) (- (cadr pta) V)) ; center of arc w/radius F
ptc (list (- (car pta) M) (+ (cadr pta) U)) ; center of arc w/radius E
pt01 (list (car pta) (+ (cadr pta) Ds))
pt02 (polar pt00
(- (/ pi 2) (/ pi N))
(+ (/ PD 2) Ds)
)
pt03 (polar ptc (d2r 285) E)
pt04 (polar ptb (d2r 105) F)
pt05 (polar ptb (d2r 270) F)
pt06 (polar ptb (d2r 60) F)
pt07 (polar pta (d2r 150) R)
pt08 (polar pt02
(- (* pi 1.5) (/ pi N))
(* Ds 1.25)
)
)
(command "zoom" "c" pta (* 4 Ds))
(DJG_LayerSet "-Visible" "4" "Continuous")
(setvar "osmode" 0)
(command "circle" pta R) ; draw circle w/radius R (seating curve)
(setq circle_R (entlast))
(command "circle" ptb F) ; draw circle w/radius F
(setq circle_F (entlast))
(command "circle" ptc E) ; draw circle w/radius E
(setq circle_E (entlast))
(setvar "osmode" 256) ; tangent osnap
(command "line" pt03 pt04 "") ; draw line tangent to circles of radii E & F
(setq line_01 (entlast))
(setvar "osmode" 0)
(command "trim" line_01 circle_R "" pt03 "") ; trim circle of radius E
(if (= DJG_RCS-frm "Y")
(progn
(command "line" pt02 pt08 "") ; draw tooth centerline
(setq line_02 (entlast))
(command "trim" line_01 line_02 "" pt05 "") ; trim circle of radius F
(command "erase" line_02 "")
)
(progn
(command "circle" pt00 "d" OD) ; draw sprocket OD
(setq circle_OD (entlast))
(command "trim" line_01 circle_OD "" pt05 pt06 "") ; trim circle of radius F
(command "mirror" circle_F "" pt00 pt02 "") ; arc temporarily needed to trim sprocket OD
(setq tmp (entlast))
(command "trim" circle_F tmp "" circle_OD "") ; trim sprocket OD
(command "erase" tmp "") ; erase temporary arc
)
)
(if (= (getvar "peditaccept") 1)
(command "pedit" circle_E "j" line_01 circle_F "" "")
(command "pedit" circle_E "y" "j" line_01 circle_F "" "")
)
(setq pline_01 (entlast))
(command "mirror" pline_01 "" pt00 pt01 "")
(setq pline_02 (entlast))
(command "trim" pline_01 pline_02 "" pt07 "") ; trim circle of radius R
(if (= DJG_RCS-frm "Y")
(command "pedit" pline_01 "j" pline_02 circle_R "" "")
(command "pedit" pline_01 "j" pline_02 circle_R circle_OD "" "")
)
(setq pline_01 (entlast))
(command "zoom" "c" pt00 PD)
(command "zoom" ".75x")
(command "array" pline_01 "" "p" pt00 N "" "")
(setq tmp pline_01
ss01 (ssadd) ; initialize ss01 to null selection set
)
(repeat (- N 1)
(ssadd (setq tmp (entnext tmp)) ss01) ; add each polyline created by array command to selection set
)
(command "pedit" pline_01 "j" ss01 "" "")
(command "rotate" pline_01 "" pt00 (/ 180.0 N)) ; rotate sprocket profile so that tooth is at 90°
(DJG_LayerSet "-Center" "5" "Center")
(command "circle" pt00 "d" PD) ; draw sprocket pitch circle
(DJG_ResetEnv)
(princ)
) ;_c:DJG_RCS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;
(defun d2r (a) (* (/ a 180.0) pi)) ; convert from degrees to radians
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;
(defun DJG_InitEnv ()
;;
;; Author: Don Grauel
;; First created: 12/02/04
;; Last updated: 01/178/05
;; Description: This function is used to initialize environment prior to running many custom routines.
;;
;;;;;;;;;;;;;;;;;;;;
(setq +*error* *error*
*error* *DJG_Error01*
+attdia (getvar "attdia")
+attreq (getvar "attreq")
+blipmode (getvar "blipmode")
+clayer (getvar "clayer")
+cmdecho (getvar "cmdecho")
+dimzin (getvar "dimzin")
+osmode (getvar "osmode")
)
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(command "undo" "mark")
(princ)
) ;_ DJG_InitEnv
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;
(defun DJG_ResetEnv ()
;;
;; Author: Don Grauel
;; First created: 12/02/04
;; Last updated: 01/17/05
;; Description: This function is used to reset environment after running many custom routines.
;;
;;;;;;;;;;;;;;;;;;;;
(setq *error* +*error*)
(setvar "attdia" +attdia)
(setvar "attreq" +attreq)
(setvar "blipmode" +blipmode)
(setvar "clayer" +clayer)
(setvar "cmdecho" +cmdecho)
(setvar "dimzin" +dimzin)
(setvar "osmode" +osmode)
(princ)
) ;_ DJG_ResetEnv
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;
(defun *DJG_Error01* (msg) ; custom error handler
(command) ; exit from any active commands
(command)
(command)
(command "undo" "back")
(if (or (= msg "Function cancelled")
(= msg "quit / exit abort")
)
(princ)
(princ (strcat "\nError: " msg))
)
(setq *error* +*error*)
(setvar "attdia" +attdia)
(setvar "attreq" +attreq)
(setvar "blipmode" +blipmode)
(setvar "clayer" +clayer)
(setvar "dimzin" +dimzin)
(setvar "osmode" +osmode)
(setvar "cmdecho" 0)
(command "undo" "mark")
(setvar "cmdecho" +cmdecho)
) ;_ *DJG_Error01*
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;
(defun DJG_LayerSet (layname laycolor lintype / tblentry laystate tmp)
;;
;; Author: Don Grauel
;; First created: 12/02/04
;; Last updated: 01/28/05
;; Description: This function sets the specified layer current, creating it if it doesn't already exist.
;;
;;;;;;;;;;;;;;;;;;;;
(setq tblentry (tblsearch "LAYER" layname)
laystate 0
)
(if tblentry
(progn
(if (/= (logand (cdr (assoc 70 tblentry)) 1) 0) ; bitcode of 1 indicates layer is frozen
(setq laystate (+ laystate 1))
)
(if (/= (logand (cdr (assoc 70 tblentry)) 4) 0) ; bitcode of 4 indicates layer is locked
(setq laystate (+ laystate 2))
)
(if (< (cdr (assoc 62 tblentry)) 0) ; color number is negative when layer is turned off
(setq laystate (+ laystate 4))
)
(command "layer" "thaw" layname "unlock" layname "on" layname "set" layname "")
)
(progn
(command "layer" "make" layname "color" laycolor "" "ltype" lintype "" "")
(setq laystate 8)
)
)
(setq tmp (strcat "\nLayer \"" layname "\" has been "))
(cond ( (= laystate 1)
(setq tmp (strcat tmp "thawed."))
)
( (= laystate 2)
(setq tmp (strcat tmp "unlocked."))
)
( (= laystate 3)
(setq tmp (strcat tmp "thawed and unlocked."))
)
( (= laystate 4)
(setq tmp (strcat tmp "turned on."))
)
( (= laystate 5)
(setq tmp (strcat tmp "thawed and turned on."))
)
( (= laystate 6)
(setq tmp (strcat tmp "unlocked and turned on."))
)
( (= laystate 7)
(setq tmp (strcat tmp "thawed, unlocked, and turned on."))
)
( (= laystate 8)
(setq tmp (strcat tmp "created."))
)
)
(if (> laystate 0) (prompt tmp))
(command "color" "bylayer")
(princ)
) ;_ DJG_LayerSet
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;
(princ)