home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / GR / GR505.ZIP / LSP.EXE / MECH.LSP < prev    next >
Text File  |  1988-08-19  |  12KB  |  404 lines
  1. ; File : MECH.LSP       8/19/88
  2. ; Author : Steve Westbrook
  3. ;
  4. ;        These are a few routines I use with mechanical drawings. As
  5. ;        I am still in the learning stages of AutoLisp, please excuse
  6. ;        the form. For some of these to work, you will need to have a
  7. ;        layer named "cenlin" with the line type of center and a layer
  8. ;        named "hidlin" with the line type of hidden. If you have any
  9. ;        suggestions or comments, please contact me on this BBS or on
  10. ;        CompuServe [76167,3410].
  11. ;
  12. (vmon)
  13. ;
  14. ;   Draws a drilled hole
  15. ;
  16. (defun C:dhole ()
  17.   (setvar "cmdecho" 0)
  18.   (setq blipsave (getvar "blipmode"))
  19.   (initget (+ 1 2))
  20.   (setq cl (getpoint "\nHole starting point: "))
  21.   (initget (+ 1 2 4))
  22.   (setq dia (getdist cl "\nDiameter of hole: "))
  23.   (initget (+ 1 2 4))
  24.   (setq depth (getdist cl "\nDepth of hole: "))
  25.   (initget 1)
  26.   (setq ang (getangle cl "\nRotation: "))
  27.   (setvar "blipmode" 0)
  28.   (setq rad (/ dia 2.0)
  29.         uang   (+ ang (/ pi 2.0))
  30.         lang   (+ ang pi)
  31.         dang   (+ ang (* pi 1.5))
  32.         pango  (+ dang (/ pi 6.0))
  33.         pangi  (- dang (/ pi 6.0))
  34.         ptdist (/ rad 0.866025)
  35.         a      (polar cl uang rad)
  36.         b      (polar a ang depth)
  37.         c      (polar b pango ptdist)
  38.         d      (polar c pangi ptdist)
  39.         e      (polar d lang depth)
  40.         f      (polar cl lang 0.0625)
  41.         g      (polar c ang 0.0625))
  42.   (command "line" a b c d e "")
  43.   (command "line" b d "")
  44.   (command "line" f g "")
  45.   (command "change" "l" "" "p" "la" "cenlin" "")
  46.   (setvar "blipmode" blipsave)
  47.   (setvar "cmdecho" 1)
  48.   (prin1)
  49. )
  50. ;
  51. ;     Draws a drilled and tapped hole
  52. ;
  53. (defun C:thole ()
  54.   (setvar "cmdecho" 0)
  55.   (setq blipsave (getvar "blipmode"))
  56.   (initget (+ 1 2))
  57.   (setq cl (getpoint "\nTapped hole starting point: "))
  58.   (initget (+ 1 2 4))
  59.   (setq dia (getdist cl "\nOutside diameter of threads: "))
  60.   (initget (+ 1 2 4))
  61.   (setq depth (getdist cl "\nDepth of drill: "))
  62.   (initget 1)
  63.   (setq ang (getangle cl "\nRotation: "))
  64.   (setvar "blipmode" 0)
  65.   (setq rad    (/ dia 2.0)
  66.         ddia   (* dia 0.84)
  67.         drad   (/ ddia 2.0)
  68.         tdepth (- depth 0.0625)
  69.         uang   (+ ang (/ pi 2.0))
  70.         lang   (+ ang pi)
  71.         dang   (+ ang (* pi 1.5))
  72.         pango  (+ dang (/ pi 6.0))
  73.         pangi  (- dang (/ pi 6.0))
  74.         ptdist (/ drad 0.866025)
  75.         a      (polar cl uang drad)
  76.         b      (polar a ang depth)
  77.         c      (polar b pango ptdist)
  78.         d      (polar c pangi ptdist)
  79.         e      (polar d lang depth)
  80.         f      (polar cl uang rad)
  81.         g      (polar f ang tdepth)
  82.         h      (polar g dang dia)
  83.         i      (polar h lang tdepth)
  84.         j      (polar cl lang 0.0625)
  85.         k      (polar c ang 0.0625))
  86.   (command "line" a b c d e "")
  87.   (command "line" b d "")
  88.   (command "pline" f g h i "")
  89.   (command "change" "l" "" "p" "la" "hidlin" "")
  90.   (command "explode" "l")
  91.   (command "line" j k "")
  92.   (command "change" "l" "" "p" "la" "cenlin" "")
  93.   (setvar "blipmode" blipsave)
  94.   (setvar "cmdecho" 1)
  95. )
  96. ;
  97. ;     Draws the front view of tapped hole
  98. ;
  99. (defun C:vthole ()
  100.   (setvar "cmdecho" 0)
  101.   (setq blipsave (getvar "blipmode"))
  102.   (initget (+ 1 2))
  103.   (setq cl (getpoint "\nCenter of tapped hole: "))
  104.   (initget (+ 1 2 4))
  105.   (setq dia (getdist cl "\nDiameter of tap: "))
  106.   (setvar "blipmode" 0)
  107.   (setq rad  (/ dia 2.0)
  108.         drad (/ (* dia 0.84) 2.0))
  109.   (command "circle" cl drad)
  110.   (command "circle" cl rad)
  111.   (command "change" "l" "" "p" "la" "hidlin" "")
  112.   (setvar "blipmode" blipsave)
  113.   (setvar "cmdecho" 1)
  114.   (prin1)
  115. )
  116. ;
  117. ;     Draw any size dowel pin
  118. ;
  119. (defun C:dowel ()
  120.   (setvar "cmdecho" 0)
  121.   (setq blipsave (getvar "blipmode"))
  122.   (initget (+ 1 2))
  123.   (setq cl (getpoint "\nStarting point of dowel pin: "))
  124.   (initget (+ 1 2 4))
  125.   (setq dia (getdist cl "\nDiameter of dowel pin: "))
  126.   (initget (+ 1 2 4))
  127.   (setq length (getdist cl "\nLength of dowel pin: "))
  128.   (initget 1)
  129.   (setq ang (getangle cl "\nRotation: "))
  130.   (setvar "blipmode" 0)
  131.   (setq rad (/ dia 2.0)
  132.         cdist 0.015)
  133.   (if (>= dia 0.3125) (setq cdist 0.03))
  134.   (setq dist  (- length (* cdist 2.0))
  135.         bdist (/ cdist 0.906308)
  136.         ddist (- rad (* cdist 0.466308))
  137.         uang  (+ ang (/ pi 2.0))
  138.         dang  (+ ang (* pi 1.5))
  139.         lang  (+ ang pi)
  140.         canga (- ang (/ pi 7.2))
  141.         cangb (+ lang (/ pi 7.2))
  142.         cangc (- lang (/ pi 7.2))
  143.         cangd (+ ang (/ pi 7.2))
  144.         a     (polar cl uang ddist)
  145.         b     (polar a cangd bdist)
  146.         c     (polar b ang dist)
  147.         d     (polar c canga bdist)
  148.         e     (polar d dang (* ddist 2.0))
  149.         f     (polar e cangb bdist)
  150.         g     (polar f lang dist)
  151.         h     (polar g cangc bdist))
  152.   (command "line" a b c d e f g h a "")
  153.   (command "line" b g "")
  154.   (command "line" c f "")
  155.   (setvar "blipmode" blipsave)
  156.   (setvar "cmdecho" 1)
  157.   (prin1)
  158. )
  159. ;
  160. ;     Draw drilled hole with counterbore
  161. ;
  162. (defun C:dholecb ()
  163.   (setvar "cmdecho" 0)
  164.   (setq blipsave (getvar "blipmode"))
  165.   (initget (+ 1 2))
  166.   (setq cl (getpoint "\nCounterbore starting point: "))
  167.   (initget (+ 1 2 4))
  168.   (setq cbdia (getdist cl "\nDiameter of counterbore: "))
  169.   (initget (+ 1 2 4))
  170.   (setq cbdepth (getdist cl "\nDepth of counterbore: "))
  171.   (initget (+ 1 2 4))
  172.   (setq dia (getdist  "\nDiameter of drill: "))
  173.   (initget (+ 1 2 4))
  174.   (setq depth (getdist cl "\nDepth of drill: "))
  175.   (initget 1)
  176.   (setq ang (getangle cl "\nRotation: "))
  177.   (setvar "blipmode" 0)
  178.   (setq rad    (/ dia 2.0)
  179.         cbrad  (/ cbdia 2.0)
  180.         depth  (- depth cbdepth)
  181.         uang   (+ ang (/ pi 2.0))
  182.         lang   (+ ang pi)
  183.         dang   (+ ang (* pi 1.5))
  184.         pango  (+ dang (/ pi 6.0))
  185.         pangi  (- dang (/ pi 6.0))
  186.         ptdist (/ rad 0.866025)
  187.         j      (polar cl ang cbdepth)
  188.         a      (polar j uang rad)
  189.         b      (polar a ang depth)
  190.         c      (polar b pango ptdist)
  191.         d      (polar c pangi ptdist)
  192.         e      (polar d lang depth)
  193.         f      (polar cl uang cbrad)
  194.         g      (polar f ang cbdepth)
  195.         h      (polar g dang cbdia)
  196.         i      (polar h lang cbdepth)
  197.         k      (polar c ang 0.0625)
  198.         l      (polar cl lang 0.0625))
  199.   (command "line" f g a b c d e h i "")
  200.   (command "line" a e "")
  201.   (command "line" b d "")
  202.   (command "line" l k "")
  203.   (command "change" "l" "" "p" "la" "cenlin" "")
  204.   (setvar "blipmode" blipsave)
  205.   (setvar "cmdecho" 1)
  206.   (prin1)
  207. )
  208. ;
  209. ;     Draw drilled hole with counterdrill
  210. ;
  211. (defun C:dholecd ()
  212.   (setvar "cmdecho" 0)
  213.   (setq blipsave (getvar "blipmode"))
  214.   (initget (+ 1 2))
  215.   (setq cl (getpoint "\nDrill starting point: "))
  216.   (initget (+ 1 2 4))
  217.   (setq cddia (getdist cl "\nDiameter of counterdrill: "))
  218.   (initget (+ 1 2 4))
  219.   (setq cddepth (getdist cl "\nDepth of counterdrill: "))
  220.   (initget (+ 1 2 4))
  221.   (setq dia (getdist  cl "\nDiameter of drill: "))
  222.   (initget (+ 1 2 4))
  223.   (setq depth (getdist cl "\nDepth of drill: "))
  224.   (initget 1)
  225.   (setq ang (getangle cl "\nRotation: "))
  226.   (setvar "blipmode" 0)
  227.   (setq rad    (/ dia 2.0)
  228.         cdrad  (/ cddia 2.0)
  229.         depth  (- depth cddepth)
  230.         uang   (+ ang (/ pi 2.0))
  231.         lang   (+ ang pi)
  232.         dang   (+ ang (* pi 1.5))
  233.         pango  (+ dang (/ pi 6.0))
  234.         pangi  (- dang (/ pi 6.0))
  235.         ptdist (/ rad 0.866025)
  236.         cddist (/ (- cdrad rad) 0.866025)
  237.         ddepth (- depth (/ cddist 2.0))
  238.         a      (polar cl uang cdrad)
  239.         b      (polar a ang cddepth)
  240.         c      (polar b pango cddist)
  241.         d      (polar c ang ddepth)
  242.         e      (polar d pango ptdist)
  243.         f      (polar e pangi ptdist)
  244.         g      (polar f lang ddepth)
  245.         h      (polar g pangi cddist)
  246.         i      (polar h lang cddepth)
  247.         j      (polar e ang 0.0625)
  248.         k      (polar cl lang 0.0625))
  249.   (command "line"  a b c d e f g h i "")
  250.   (command "line" b h "")
  251.   (command "line" c g "")
  252.   (command "line" d f "")
  253.   (command "line" j k "")
  254.   (command "change" "l" "" "p" "la" "cenlin" "")
  255.   (setvar "blipmode" blipsave)
  256.   (setvar "cmdecho" 1)
  257.   (prin1)
  258. )
  259. ;
  260. ;     Draw finish mark with surface roughness
  261. ;
  262. (defun C:fmark ()
  263.   (setvar "cmdecho" 0)
  264.   (setq blipsave (getvar "blipmode"))
  265.   (initget (+ 1 2))
  266.   (setq cl (getpoint "\nInsertion point: "))
  267.   (initget 1)
  268.   (setq ang (getangle cl "\nRotation: "))
  269.   (setq temp (getstring T "\nMaximum surface roughness: "))
  270.   (setvar "blipmode" 0)
  271.   (setq uang   (+ ang (/ pi 2.0))
  272.         rang   (+ ang (/ pi 3.0))
  273.         lang   (+ rang (/ pi 3.0))
  274.         a      (polar cl lang 0.0808)
  275.         b      (polar cl rang 0.2425)
  276.         c      (polar a uang 0.035)
  277.         angdeg (* ang 57.29578))
  278.   (command "line" a cl b "")
  279.   (command "text" "c" c "0.07" angdeg temp)
  280.   (setvar "blipmode" blipsave)
  281.   (setvar "cmdecho" 1)
  282.   (prin1)
  283. )
  284. ;
  285. ;     Draw Section Arrows in any rotation
  286. ;
  287. (defun C:secarr ()
  288.   (setvar "cmdecho" 0)
  289.   (setq blipsave (getvar "blipmode"))
  290.   (initget (+ 1 2))
  291.   (setq cl (getpoint "\nInsertion point: "))
  292.   (initget 1)
  293.   (setq ang (getangle cl "\nDirection of leader: "))
  294.   (initget 1)
  295.   (setq a (polar cl ang 0.25))
  296.   (setq sang (getangle a "\nDirection of arrowhead: "))
  297.   (setvar "blipmode" 0)
  298.   (setq b (polar a sang 0.125))
  299.   (setq c (polar b sang 0.21875))
  300.   (command "trace" "0.03" cl a b "")
  301.   (command "insert" "arrow" c "2" "2.5" a)
  302.   (setvar "blipmode" blipsave)
  303.   (setvar "cmdecho" 1)
  304.   (prin1)
  305. )
  306. ;
  307. ;     Import ascii files into AutoCad
  308. ;
  309. (defun C:txtin (/ AF)
  310. ;
  311. (defun dotxt ()
  312.   (setq styl (getstring "\nStyle name <STANDARD>: "))
  313.   (if (= styl "") (setq styl "STANDARD"))
  314.   (setq s (strcase(getstring "Locate text at <L>eft/Center/Middle/Right: ")))
  315.   (if (= s "") (setq s "L"))
  316.   (cond
  317.     ((= s "L") (setq spoint (getpoint "\nStarting point: ")))
  318.     ((= s "C") (setq spoint (getpoint "\nCenter point: ")))
  319.     ((= s "M") (setq spoint (getpoint "\nMiddle point: ")))
  320.     ((= s "R") (setq spoint (getpoint "\nEnd point: ")))
  321.   )
  322.   (setq ht (getdist spoint
  323.     (strcat "\n Height <"
  324.     (rtos (getvar "TEXTSIZE") (getvar "LUNITS") (getvar "LUPREC")) ">: ")))
  325.   (if (= ht nil) (setq ht (getvar "TEXTSIZE")))
  326.   (setq rot (getangle spoint "\nRotation angle <0>: "))
  327.   (if (= rot nil) (setq rot 0.0))
  328.   (setvar "cmdecho" 0)
  329.   (setq blipsave (getvar "blipmode"))
  330.   (setvar "blipmode" 0)
  331.   (setq txt (read-line AF))
  332.   (if (= s "L") (command "TEXT" "S" styl spoint ht rot txt)
  333.                 (command "TEXT" "S" styl s spoint ht rot txt))
  334.   (while (/= txt nil)
  335.     (setq txt (read-line AF))
  336.     (setq spoint (polar spoint (+ rot (* 1.5 pi)) (* (/ 5.0 3.0) ht)))
  337.     (if (= s "L") (command "TEXT" spoint ht rot txt)
  338.                   (command "TEXT" s spoint ht rot txt))
  339.   )
  340.   (close AF)
  341.   (setvar "blipmode" blipsave)
  342.   (setvar "cmdecho" 1)
  343. )
  344. ;
  345. ;
  346. ;
  347.   (setq AF (open (getstring "\nName of Ascii file to insert: ") "r"))
  348.   (if (/= AF nil) (dotxt) (prompt "File not found!"))
  349.   (prin1)
  350. )
  351. ;
  352. ;     Edit exsisting Text entities
  353. ;
  354. (defun C:chgtxt ()
  355. ;
  356. ;
  357. (defun swap (key tval /)
  358.   (setq tv2 (assoc key te)
  359.         tv4 (cons key tv1)
  360.         te (subst tv4 tv2 te))
  361. )
  362. ;
  363. ;
  364.   (setq tset (ssget))
  365.   (setq len (sslength tset))
  366.   (setq c 0)
  367.   (setvar "cmdecho" 0)
  368.   (if (> len 0)
  369.     (progn
  370.       (setq cmd (strcase
  371.         (getstring "Change Height/X-scale/Style/<V>alue: ")))
  372.       (cond
  373.         ((OR (= cmd "V") (= cmd ""))
  374.           (setq tv1 (getstring T "Enter new text string: "))
  375.           (setq key 1))
  376.         ((= cmd "H")
  377.           (setq tv1 (getreal "Enter new text height: "))
  378.           (setq key 40))
  379.         ((= cmd "X")
  380.           (setq tv1 (getreal "Enter new X-scale factor: "))
  381.           (setq key 41))
  382.         ((= cmd "S")
  383.           (setq tv1 (getstring "Enter new text style: "))
  384.           (setq key 7))
  385.         (T (setq key 0))
  386.       )
  387.       (if (> key 0)
  388.         (progn
  389.           (while (< c len)
  390.             (setq ename (ssname tset c))
  391.             (setq te (entget ename))
  392.             (if (= (cdr (assoc 0 te)) "TEXT") (swap key tv1))
  393.             (entmod te)
  394.             (setq c (1+ c))
  395.           )    ;while
  396.         )      ; progn
  397.       )        ; if
  398.     )          ; progn
  399.   )            ; if
  400.   (setvar "cmdecho" 1)
  401.   (prin1)
  402. )
  403. ;
  404.