home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / autocad / acadtut.arj / LESSON.EXE / TEST.LSP < prev   
Encoding:
Lisp/Scheme  |  1990-04-05  |  6.3 KB  |  198 lines
  1. ;lesson1 lisp routine to check answers to CAD lesson #1
  2.  
  3. (defun C:ANSWERS (/ set1 n na text user )
  4. (setq set1 (ssget '(5.87 0.85)))
  5. (if (= set1 nil)(command "insert" "bad" "8.08,6.5" "" "" "")(progn
  6. (setq n (sslength set1))
  7. (setq na (ssname set1 0))
  8. (setq text (cddr (entget na)))
  9. (setq user (strcase (cdr (assoc 1 text))))
  10.   (if 
  11.        (or (= user "USER1")
  12.            (= user "USER2")
  13.            (= user "USER3")
  14.            (= user "USER4")
  15.            (= user "USER5")
  16.            (= user "USER6")
  17.            (= user "USER7")
  18.            (= user "USER8")
  19.            (= user "USER9")
  20.            (= user "USER0")
  21.        )
  22.            (command "insert" "ok" "8.08,6.5" "" "" "");then
  23.            (command "insert" "bad" "8.08,6.5" "" "" ""))));else
  24. (redraw)
  25. (AN2)
  26. )
  27.  
  28. (defun an2 ()
  29. ;first answer
  30. (defun a1 (/ seta n na tp tp1 mtl1)
  31. (setq seta (ssget '(1 6)))
  32. (setq n (sslength seta))
  33. (setq na (ssname seta 0))
  34. (setq tp (car(cdr(entget na))));next three lines check for no answer
  35. (setq tp1(cdr tp))
  36. (if (= tp1 "LINE") 
  37. (command "insert" "bad" "8.08,6" "" "" "");then
  38. (progn(setq text (cddr (entget na)));else
  39.       (setq mtl1 (list (strcase (cdr (assoc 1 text)))))
  40.       (if (or(= (car mtl1) "ABSOLUTE")
  41.              (= (car mtl1) "POLAR")
  42.              (= (car mtl1) "RELATIVE")
  43.             )
  44.           (command "insert" "ok" "8.08,6" "" "" "")   
  45.            (command "insert" "bad" "8.08,6" "" "" ""));else
  46.       ))
  47. )
  48. ;next answer
  49. (defun a2 (/ setb n na tp tp1)
  50. (setq setb (ssget '(1 5.8)))
  51. (setq n (sslength setb))
  52. (setq na (ssname setb 0))
  53. (setq tp (car(cdr(entget na))));next three lines check for no answer
  54. (setq tp1(cdr tp))
  55. (if (= tp1 "LINE") 
  56. (command "insert" "bad" "8.65,6" "" "" "");then
  57. (progn(setq text (cddr (entget na)));else
  58.       (setq mtl2 (list (strcase (cdr (assoc 1 text)))))
  59.       (if (or(= (car mtl2) "ABSOLUTE")
  60.              (= (car mtl2) "POLAR")
  61.              (= (car mtl2) "RELATIVE")
  62.             )
  63.           (command "insert" "ok" "8.65,6" "" "" "")   
  64.            (command "insert" "bad" "8.65,6" "" "" ""));else
  65.       ))
  66. )
  67. ; last answer
  68. (defun a3 (/ setc n na tp tp1)
  69. (setq setc (ssget '(1 5.6)))
  70. (setq n (sslength setc))
  71. (setq na (ssname setc 0))
  72. (setq tp (car(cdr(entget na))));next three lines check for no answer
  73. (setq tp1(cdr tp))
  74. (if (= tp1 "LINE") 
  75. (command "insert" "bad" "9.2,6" "" "" "");then
  76. (progn(setq text (cddr (entget na)));else
  77.       (setq mtl3 (list (strcase (cdr (assoc 1 text)))))
  78.       (if (or(= (car mtl3) "ABSOLUTE")
  79.              (= (car mtl3) "POLAR")
  80.              (= (car mtl3) "RELATIVE")
  81.             )
  82.           (command "insert" "ok" "9.2,6" "" "" "")   
  83.            (command "insert" "bad" "9.2,6" "" "" ""));else
  84.       ))
  85. )
  86. (a1)
  87. (a2)
  88. (a3)
  89. (REDRAW)
  90. (Q3)
  91. )             
  92.  
  93. (defun Q3 ()
  94. (setq ans3 (strcase(getstring "\nENTER YOUR ANSWER TO QUESTION #3 <T/F>")))
  95. (if (= ans3 "T") (PROGN(command "text" "1,4.5" "" "T" )
  96.           (command "insert" "ok" "8.08,5.5" "" "" ""))   
  97.            (PROGN(command "text" "1,4.5" "" "F" )
  98.            (command "insert" "bad" "8.08,5.5" "" "" "")))
  99. (REDRAW)
  100. (q4)
  101. );end defun3
  102.  
  103. (defun q4 ()
  104. (prompt "\nPLEASE READ QUESTION #4 BEFORE ANSWERING")
  105. (setq ans4 (strcase(getstring "\nENTER YOUR ANSWER TO QUESTION #4 <T/F>")))
  106. (if (= ans4 "T") (PROGN(command "text" "1,4" "" "T" )
  107.           (command "insert" "ok" "8.08,5" "" "" ""))   
  108.            (PROGN(command "text" "1,4" "" "F" )
  109.            (command "insert" "bad" "8.08,5" "" "" "")))
  110. (REDRAW)
  111. (q5)
  112. );end defun4
  113.  
  114. (defun q5 ()
  115. (prompt "\nPLEASE READ QUESTION #5 BEFORE ANSWERING")
  116. (setq ans5 (strcase(getstring "\nENTER YOUR ANSWER TO QUESTION #5" )))
  117. (if (= ans5 "LAYER") (PROGN(command "text" "1,3.5" "" ans5 )
  118.           (command "insert" "ok" "8.08,4.5" "" "" ""))   
  119.            (PROGN(command "text" "1,3.5" "" ans5 )
  120.            (command "insert" "bad" "8.08,4.5" "" "" "")))
  121. (REDRAW)
  122. (q6)
  123. );end defun5
  124.  
  125. (defun q6 ()
  126. (prompt "\nPLEASE READ QUESTION #6 BEFORE ANSWERING")
  127. (setq ans6 (strcase(getstring "\nENTER YOUR ANSWER TO QUESTION #6 <T/F>")))
  128. (if (= ans6 "F") (PROGN(command "text" "4.8,6" "" "F" )
  129.           (command "insert" "ok" "8.08,4" "" "" ""))   
  130.            (PROGN(command "text" "4.8,6" "" "T" )
  131.            (command "insert" "bad" "8.08,4" "" "" "")))
  132. (REDRAW)
  133. (q7)
  134. );end defun6
  135.  
  136. (defun q7 ()
  137. (prompt "\nPLEASE READ QUESTION #7 BEFORE ANSWERING")
  138. (setq ans7 (strcase(getstring "\nENTER YOUR ANSWER TO QUESTION #7 ")))
  139. (if (= ans7 "C") (PROGN(command "text" "4.8,5.3" "" ans7 )
  140.           (command "insert" "ok" "8.08,3.5" "" "" ""))   
  141.            (PROGN(command "text" "4.8,5.3" "" ans7 )
  142.            (command "insert" "bad" "8.08,3.5" "" "" "")))
  143. (REDRAW)
  144. (q8)
  145. );end defun7
  146.  
  147. (defun q8 ()
  148. (prompt "\nPLEASE READ QUESTION #8 BEFORE ANSWERING")
  149. (setq ans8 (strcase(getstring "\nENTER YOUR ANSWER TO QUESTION #8 <T/F>")))
  150. (if (= ans8 "F") (PROGN(command "text" "4.8,4.5" "" "F" )
  151.           (command "insert" "ok" "8.08,3" "" "" ""))   
  152.            (PROGN(command "text" "4.8,4.5" "" "T" )
  153.            (command "insert" "bad" "8.08,3" "" "" "")))
  154. (REDRAW)
  155. (q9)
  156. );end defun8
  157.  
  158. (defun q9 ()
  159. (prompt "\nPLEASE READ QUESTION #9 BEFORE ANSWERING")
  160. (setq ans9 (strcase(getstring "\nENTER YOUR ANSWER TO QUESTION #9" )))
  161. (if (= ans9 "B") (PROGN(command "text" "4.8,3.9" "" ans9 )
  162.           (command "insert" "ok" "8.08,2.5" "" "" ""))   
  163.            (PROGN(command "text" "4.8,3.9" "" ans9 )
  164.            (command "insert" "bad" "8.08,2.5" "" "" "")))
  165. (REDRAW)
  166. (q10)
  167. );end defun9
  168.  
  169. (defun q10 ()
  170. (prompt "\nPLEASE READ QUESTION #10 BEFORE ANSWERING")
  171. (setq ans10 (strcase(getstring "\nENTER YOUR ANSWER TO QUESTION #10 <T/F>")))
  172. (if (= ans10 "F") (PROGN(command "text" "4.8,3.1" "" "F" )
  173.           (command "insert" "ok" "8.08,2" "" "" ""))   
  174.            (PROGN(command "text" "4.8,3.1" "" "T" )
  175.            (command "insert" "bad" "8.08,2" "" "" "")))
  176. (REDRAW)
  177. (Q11)
  178. );end defun10
  179.  
  180. (defun q11 ()
  181. (prompt "\nPLEASE READ QUESTION #11 BEFORE ANSWERING")
  182. (setq ans11 (strcase(getstring "\nENTER YOUR ANSWER TO QUESTION #11" )))
  183. (if (OR (= ans11 "A")
  184.         (= ans11 "B")
  185.         (= ans11 "C")
  186.     )    
  187. (command "insert" "closing" "5.23,1.47" "" "" ""))   
  188. (REDRAW)
  189. (command "end" )
  190. );end defun11
  191.  
  192. (defun c:ldl ()
  193. (load"lesson1")
  194. )
  195. (defun c:el ()
  196. (command "blue" "lesson1.lsp" )
  197. )
  198.