home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p024 / 15.img / AME2.LIB / HOLE.LSP < prev    next >
Encoding:
Text File  |  1993-02-08  |  9.0 KB  |  323 lines
  1. ;;;   HOLE.lsp
  2. ;;;   ¬⌐┼v (C) 1992  Autodesk ñ╜Ñq
  3. ;;;
  4. ;;;   Ñ╗│n┼ΘºK╢O¿╤▒z╢iªµÑ⌠ª≤Ñ╬│~╗▌¿D¬║½■¿⌐íB¡╫º∩ñ╬╡oªµ, ª²¼O░╚╜╨┐φ┤`ñU¡z
  5. ;;;   ¡∞½h :
  6. ;;;
  7. ;;;   1)  ñWªC¬║¬⌐┼v│qºi░╚╗▌ÑX▓{ªb¿Cñ@Ñ≈½■¿⌐∙╪íC
  8. ;;;   2)  ¼█├÷¬║╗í⌐·ñσÑ≤ñ]Ñ▓╢╖⌐·╕ⁿ¬⌐┼v│qºiñ╬Ñ╗╢╡│\Ñi│qºiíC
  9. ;;;
  10. ;;;   Ñ╗│n┼Θ╢╚┤ú¿╤º@¼░└│Ñ╬ñW¬║░╤ª╥, ª╙Ñ╝┴n⌐·⌐╬┴⌠ºtÑ⌠ª≤½O├╥; ╣∩⌐≤Ñ⌠ª≤»S«φ
  11. ;;;   Ñ╬│~ñº╛A║┘⌐╩, ÑHñ╬░╙╖~╛P░Γ⌐╥┴⌠ºtÑX¿π¬║½O├╥, ªbª╣ñ@╖ºñ⌐ÑHº_╗{íC
  12. ;;;
  13. ;;;
  14. ;;;   By Rick Barrientos
  15. ;;;   Thanks to Levent Setzer for providing technical support.
  16. ;;;   Version 0.6               9 March 1992
  17. ;;;
  18. ;;;----------------------------------------------------------------------------;
  19. ;;;
  20. ;;;   DESCRIPTION
  21. ;;;
  22. ;;;   HOLE.LSP is a sample AME 2.0 lisp routine.
  23. ;;;
  24. ;;;   It allows feature based creation of countersinks and counterbores.
  25. ;;;   It makes use of api functions called through Autolisp. It will not
  26. ;;;   run with AME 1.0 as these functons were not supported through
  27. ;;;   Autolisp at that time.
  28. ;;;
  29. ;;;   The program is loaded and called by typing "hole". The user is then
  30. ;;;   prompted to select a counterbore or countersink. A face with a hole
  31. ;;;   must be selected next. This face must be planar. The edge of the
  32. ;;;   hole to countersink or counterbore must then be selected. This must
  33. ;;;   be a round hole and must lie on the face previously selected.
  34. ;;;
  35. ;;;   To create a counterbore, the user must specify a diameter or radius
  36. ;;;   and a depth for the feature. To create a countersink, the user
  37. ;;;   must input a diameter or radius and an included angle.
  38.  
  39. ;input parameters function
  40. (defun input (
  41.        typ
  42.        /
  43.        loop finfo edge einfo axis check lp chk err
  44.        )
  45. ;select the face
  46. (setq loop 1)
  47. (while (= loop 1)
  48.    ;--------------------------------------
  49.    ;check CTR-C to break out of the loop
  50.    (if (and (null (setq face (ap_sel_face (strcat "\n┐∩╛▄ñw╞pñ╒¬║Ñ¡¡▒í╨"
  51.               (cdr (assoc typ alist)) ": \n"))))
  52.             (/= 45 (setq err (ap_last_errcode)))
  53.        )
  54.      (prompt "\n┐∩⌐w¬║║cñ╕ñú¼░íu¡▒ív; ╜╨ªA╕╒íC")
  55.      (progn
  56.        ;---------------------------
  57.        (if (= 45 err)
  58.          (setq loop 0)
  59.          (progn
  60.            (setq finfo (ap_get_faceinfo face))
  61.            ;check to see that selected face is planar
  62.            (if (/= 0 (car finfo))
  63.              (princ "\n┐∩⌐w╣∩╢Hñú¼░íuÑ¡¡▒ív; ╜╨ªA╕╒íC\n")
  64.              (setq loop 0)
  65.            )
  66.          )
  67.        )
  68.      )
  69.    )
  70. )
  71.  
  72.  
  73.  
  74. ;select the edge
  75. (if (= 45 err)
  76.   (setq loop 0)
  77.   (setq loop 1)
  78. )
  79.  
  80. (while (= loop 1)
  81.    ;check the value of variable edge
  82.    ;---------------------------------------------
  83.    ;check CTR-C to break out of the loop
  84.    (if (and (null (setq edge (ap_sel_edge (strcat "\n┐∩╛▄íu╞pñ╒╜t├Σíví╨" (cdr (assoc typ alist)) ": "))))
  85.             (/= 45 (setq err (ap_last_errcode)))
  86.        )
  87.       (prompt "\n┐∩⌐w¬║║cñ╕ñú¼░íu╜t├Σív; ╜╨ªA╕╒íC")
  88.       (progn
  89.         ;-----------------------------------------
  90.         (if (= 45 err)
  91.           (setq loop 0)
  92.           (progn
  93.             (setq einfo (ap_get_edgeinfo edge))
  94.             ;get ru and rv
  95.             (setq axis (nth 7 einfo))
  96.             ;check that edge is on face
  97.             (setq check (ap_face2edges face))
  98.             ;check that edge round and on face
  99.             (if (or
  100.                   (or (/= 1 (car einfo)) (/= (car axis) (cadr axis)))
  101.                   (null (member (cadr edge) check))
  102.                 )
  103.               (Princ "\n╜t├ΣÑ▓╢╖ªb┐∩⌐w¬║íu¡▒ñ╕ívñW, ÑB└│¼░íuÑ┐╢ΩívíC\n")
  104.               (setq loop 0)
  105.             );if
  106.          )
  107.         );if
  108.       )
  109.   );if
  110. )
  111.  
  112. ;-----------------------------------
  113. (if (/= 45 err)
  114.   (progn
  115.     ;get center of edge
  116.     (setq cx (nth 3 (nth 0 (nth 4 einfo))))
  117.     (setq cy (nth 3 (nth 1 (nth 4 einfo))))
  118.     (setq cz (nth 3 (nth 2 (nth 4 einfo))))
  119.     (setq cen (list cx cy cz))
  120.  
  121.     ;get face normal
  122.     (setq nx (nth 0 (car (nth 3 finfo))))
  123.     (setq ny (nth 1 (car (nth 3 finfo))))
  124.     (setq nz (nth 2 (car (nth 3 finfo))))
  125.  
  126.     ;def,rdef and ddef should be global variables
  127.     ;get Diameter of CBore/CSink
  128.     (setq loop 1)
  129.     (while (= loop 1)
  130.      (setq lp 1)
  131.      (while (= lp 1)
  132.       (if (= def nil) (setq def "Diameter"))
  133.       (if (= rdef nil)
  134.         (progn
  135.           (if (= def "Radius")
  136.             (setq rdef (* 1.5 (car axis)))
  137.           )
  138.           (if (= def "Diameter")
  139.             (setq rdef (* 3.0 (car axis)))
  140.           )
  141.         )
  142.       );if
  143.       ;prompt with hole radius
  144.       (if (= def "Radius")
  145.         (progn
  146.           (princ "\n┐∩⌐w¬║íu╞pñ╒Ñb«|ív: ")
  147.           (princ (car axis))
  148.         )
  149.       )
  150.       ;prompt with hole diameter
  151.       (if (= def "Diameter")
  152.         (progn
  153.          (princ "\n┐∩⌐w¬║íu╞pñ╒¬╜«|ív: ")
  154.          (princ (* 2 (car axis)))
  155.         )
  156.       );if
  157.       (if (= def "Radius") (princ "\nD¬╜«| ⌐╬ <RÑb«|> "))
  158.       (if (= def "Diameter") (princ "\nRÑb«| ⌐╬ <D¬╜«|> "))
  159.       (initget 6 "Radius Diameter")
  160. ;prompt with size of feature
  161.       (princ "í╨") (princ (cdr (assoc typ alist))) (princ" <")
  162.       (princ rdef)
  163.       (princ ">: ")
  164. ;get feature size
  165.       (setq rad (getdist))
  166.       (if (= rad nil) (setq rad rdef))
  167.       (setq rdef rad)
  168.       (if (= rad "Radius") (setq chk "Radius"))
  169.       (if (= rad "Diameter") (setq chk "Diameter"))
  170.       (if (= chk "Diameter") (setq def "Diameter"))
  171.       (if (= chk nil) (setq chk def))
  172.       (if (= chk "Radius") (setq def "Radius"))
  173.  
  174. ;ifrdef is not defined, set to one and a half times hole size
  175. ;if it is defined, keep definition
  176.       (if (or (= rad "Radius") (= rad "Diameter"))
  177.         (progn (setq rad nil) (setq rdef rad))
  178.           (setq lp 0)
  179.  
  180.       );if
  181.     );while
  182. ;check  that CBore Diameter/Radius is larger than hole Diameter
  183.  
  184.       (if
  185.          (or
  186.          (and (= chk "Diameter") (<= rad (* 2 (car axis))))
  187.          (and (= chk "Radius") (<= rad (car axis)))
  188.          )
  189.       (progn
  190.          (princ "\n─╡ºi:") (princ (cdr (assoc def alist)))
  191.          (princ "ñp⌐≤íuñ╒«|ívíC")
  192.       )
  193.       (setq loop 0)
  194.       );if
  195.   );while
  196.   )
  197. );if
  198. err
  199. )
  200.  
  201. ; function that makes the counterbore
  202. (defun makecb (/ px py pz p2 a)
  203.    ;get depth of CBore
  204.      (if (= ddef nil) (setq ddef 1.0))
  205.      (princ "\n▓`½╫í╨") (princ (cdr (assoc typ alist))) (princ ":<")
  206.      (princ ddef)
  207.      (princ "> ")
  208.           (initget (+ 2 4))
  209.      (setq depth (getdist))
  210.      (if (= depth nil) (setq depth ddef))
  211.      (setq ddef depth)
  212.  
  213. ;calculate endpoint of CBore
  214.  
  215.    (command "_.ucs" "_w")
  216.  
  217.    (setq px (- cx (* depth nx)))
  218.    (setq py (- cy (* depth ny)))
  219.    (setq pz (- cz (* depth nz)))
  220.    (setq p2 (list px py pz))
  221.  
  222. ;make CBore
  223.  
  224.    (if (= def "Radius") (setq b (SOLCYL cen rad "c" p2)))
  225.    (if (= def "Diameter") (setq b (SOLCYL cen "d" rad "c" p2)))
  226.    (setq a (ap_obj2name (car face)))
  227.  
  228.    (SOLSUB a b)
  229.    (command "_.ucs" "_p")
  230. )
  231.  
  232. ; function that makes the countersink
  233. (defun makecs (/ iang ang a b px py pz p2)
  234. ;get included angle and calculate depth of CSink
  235.    (if (= iang nil) (setq iang 82.0))
  236.    (princ "\n┬Xñ╒└@¿ñí╨ÑHíu½╫ív¡p <")
  237.    (princ iang) (princ ">: ")
  238.    (initget 6)
  239.    (setq ang (getreal))
  240.    (if (= ang nil) (setq ang iang))
  241.    (setq iang ang)
  242.    (setq a (/ ang 2))
  243.    (if (= def "Diameter") (setq r (/ rad 2))
  244.       (setq r rad))
  245.    (setq depth (/ r
  246.       (/ (sin (/ a (/ 180 pi)))
  247.       (cos (/ a (/ 180 pi))))
  248.    ))
  249. ;calculate endpoint of CSink
  250.  
  251.    (command "_.ucs" "_w")
  252.  
  253.    (setq px (- cx (* depth nx)))
  254.    (setq py (- cy (* depth ny)))
  255.    (setq pz (- cz (* depth nz)))
  256.    (setq p2 (list px py pz))
  257.  
  258. ;make CSink
  259.  
  260.    (if (= def "Radius") (setq b (SOLCONE cen rad "a" p2)))
  261.    (if (= def "Diameter") (setq b (SOLCONE cen "d" rad "a" p2)))
  262.    (setq a (ap_obj2name (car face)))
  263.  
  264.    (SOLSUB a b)
  265.    (command "_.ucs" "_p")
  266. )
  267.  
  268. ;option function
  269. ;typ is a global variable so function will remember last option
  270. (defun option(/ type)
  271.  
  272.         (initget "CSink CBore")
  273.         (if (= typ "CSink")
  274.         (princ "\nCBÑ¡⌐│┬Xñ╒/<CS└@º╬┬Xñ╒>: "))
  275.         (if (/= typ "CSink")
  276.           (progn
  277.             (setq typ "CBore")
  278.             (princ "\nCS└@º╬┬Xñ╒/<CBÑ¡⌐│┬Xñ╒>: ")
  279.           )
  280.         )
  281.         (setq type (getkword))
  282.         (if (= type nil) (setq type typ))
  283.         (setq typ type)
  284.         (if (= typ nil) (setq typ "CBore"))
  285.  
  286.         ;---------------------------------------------------
  287.         ;check whether user enter CTR-C
  288.         (if (= typ "CSink")
  289.           (if (/= 45 (input typ))
  290.             (makecs)
  291.           )
  292.         )
  293.         ;---------------------------------------------------
  294.         ;check whether user enter CTR-C
  295.         (if (= typ "CBore")
  296.           (if (/= 45 (input typ))
  297.             (makecb)
  298.           )
  299.         )
  300. )
  301. ;error handler
  302. (defun *error* (msg)
  303.   (princ "┐∙╗~: ")
  304.   (princ msg)
  305.   (princ)
  306. )
  307.  
  308. ;main function
  309. (defun c:HOLE( / quit alist)
  310.    (setq quit 0)
  311.    (setvar "cmdecho" 0)
  312.  
  313.    (if (not ap_sel_face)
  314.    (progn
  315.    (princ "\n░⌡ªµª╣Ñ\»αñº½e, Ñ▓╢╖Ѳ╕ⁿñJ AME 2.0 ╢∞½¼╡{ªííC")
  316.    (setq quit 1)))
  317.  
  318.    (if (/= quit 1) (option))
  319.    (setvar "cmdecho" 1)
  320.    (princ)
  321. )
  322.  
  323.