Tài liệu Chương trình autolisp

Bé m«n GCVL&DCCN - §å ¸n tèt nghiÖp - CTM K39 Ch¬ng tr×nh Autolisp ;;------------------------------------------------------;; Subroutine: th©n khai ;; dïng ®Ó vÏ biªn d¹ng th©n khai ;; tham sè: t©m: täa ®é t©m b¸nh r¨ng cÇn vÏ ;; r0: b¸n kÝnh c¬ së ;; Rmin va Rmax: b¸n kÝnh ch©n vµ ®Ønh ;;------------------------------------------------------(defun thankhai ( tam r0 Rmin Rmax / phi phi1 phi2 step i ) (setq ptlist nil num 5) (if (> r0 Rmin) (progn (setq phi1 (/ (setq l (sqrt (- (* r0 r0) (* rmin rmin)))) rmin)) (setq phi1 (- (atan (/ l rmin)) phi1)) (setq ptlist (append ptlist (list (polar tam phi1 rmin) (polar tam 0 r0) ) ) ) (setq step (/ (- rmax r0) num 1.0) rtk r0) ) (setq ptlist (append ptlist (list (polar tam 0 rmin))) step (/ (- rmax rmin) num 1.0) rtk rmin) ) (princ step) (princ "***") (repeat num (princ (setq rtk (+ rtk step))) (princ " ") (setq phi1 (/ (setq l (sqrt (- (* rtk rtk) (* r0 r0)))) r0)) (setq phi2 (atan (/ l r0)) phi (- phi1 phi2)) (setq ptlist (append ptlist (list (polar tam phi rtk)))) ) ptlist ) Bé m«n GCVL&DCCN - §å ¸n tèt nghiÖp - CTM K39 ;;------------------------------------------------------;; C:GEAR - dïng ®Ó vÏ b¸nh r¨ng víi m, z vµ  (anfa) ;; cho vµo tõ bµn phÝm ;;------------------------------------------------------(defun c:gear ( / pts1 dc de di d0 anfa z m zve tam pts phi1 phi2 s1 s2 ) (setq tam (getpoint "\nT©m: ") m (getreal "\nModun: ") z (getint "\nSè r¨ng: ") b (getdist "\nBÒ réng: ") anfa (getreal "\nGãc ¸p lùc: ") zve (getint "\nSè r¨ng cÇn vÏ: ") ) (setq dc (* m z) de (+ dc m m) di (- dc (* 2.25 m)) d0 (* dc (cos (/ (* pi anfa) 180.0)))) (setq pts (thankhai tam (/ d0 2.0) (/ di 2.0) (/ de 2.0))) (command ".pline") (foreach pt pts (command pt)) (command "") (setq s1 (entlast) ang (/ pi 2 z)) (setq phi1 (/ (setq l (sqrt (- (* (/ dc 2.0) (/ dc 2.0)) (* (/ d0 2.0) (/ d0 2.0)) ) ) ) (/ d0 2.0) ) ) (setq phi2 (atan (/ l (/ d0 2.0))) phi (- phi1 phi2) ) (setq pt2 (polar tam (+ phi ang) (/ dc 2.0))) (command ".mirror" s1 "" tam pt2 "n") (setq s2 (entlast) pts2 nil) (while (setq s2 (entnext s2)) (setq ent (entget s2)) (if (= (cdr (assoc 0 ent)) "VERTEX") (setq pts2 (append pts2 (list (cdr (assoc 10 ent))))) ) ) (setq s2 (entlast)) (setq ang1 (angle tam (car pts))) (if (> ang1 pi) (setq ang1 (- ang1 (* 2 pi)))) (setq ang2 (* 2.0 (- (+ phi ang) ang1))) (setq ang3 (+ ang2 (- (/ (* 2 pi) z) ang2))) (command ".arc" (car pts2) "e" (polar tam (+ ang1 ang3) (/ di 2.0)) "r" (/ di 2.0)) (setq s3 (entlast)) (command ".arc" (last pts) "e" (last pts2) "r" (/ de 2.0)) (setq s4 (entlast)) (command ".array" s1 s2 s4 s3 "" "p" tam zve (* (/ 360.0 z) (1- zve)) "") (if (< zve z) Bé m«n GCVL&DCCN - §å ¸n tèt nghiÖp - CTM K39 (progn (setq goc (cdr (assoc 50 (entget (entlast))))) (entdel (entlast)) (command "line" (car pts) tam (polar tam goc (/ di 2.0)) "") ) ) (command ".pedit" s1 "j" "all" "" "x") ; (command ".extrude" "l" "" b "") ) ;;------------------------------------------------------;; C:PHAYDIA - dïng ®Ó m« pháng qu¸ tr×nh gia c«ng ;; b»ng ph¬ng ph¸p chÐp h×nh ;; (dao phay ®Üa modun) ;;------------------------------------------------------(defun c:phaydia ( ) (command "undo" "m") (setvar "cmdecho" 0) (setq tam (getpoint "\nT©m quay cña ph«i: ") m (getreal "\nModun b¸nh r¨ng cÇn gia c«ng: ") z (getint "\nSè r¨ng b¸nh r¨ng: ") ) (princ "\n***********************************") (princ "\n H·y chän ph«i: ") (setq s1 (car (entsel))) (princ "\n H·y chän dao phay ®Üa: ") (setq s2 (car (entsel))) (setq pt1 '(0 0 0) step (getdist "\nBíc dÞch cña dao (theo Z) ®Ó gia c«ng hÕt bÒ dµy r¨ng: ") Nd (getint "\nSè lÇn dÞch dao: ") Zgc (getint "\nSè r·nh r¨ng cÇn gia c«ng: ") pt2 (list (car pt1) (cadr pt1) (+ (last pt1) step)) ) (initget "C K") (setq ans (getkword "\nB¹n cã muèn t¹o ¶nh kh«ng ? /C: ")) (if (= "C" ans) (progn (initget) (setq i (getint "\nSè thø tù cña tÖp ¶nh®Çu tiªn: ")) ) ) (setq Rc (/ (* m z) 2.0) phando (/ 360.0 z)) (setq chieu (getint "\nChiÒu quay theo kim ®ång hå (-1) hay ngîc l¹i (+1) ? <+1>/-1: ")) (if (<= chieu 0) (setq phando (- phando))) ; (setvar "osnap" "none") (repeat Zgc (setq j 0) (repeat (1+ Nd) Bé m«n GCVL&DCCN - §å ¸n tèt nghiÖp - CTM K39 (command ".copy" s2 "" "@" "@") (command "subtract" s1 "" "l" "") (if (= "C" ans) (progn (c:render) (c:saveimg (itoa (setq i (1+ i))) "gif") ) ) (command ".move" s2 "" pt1 pt2) (setq j (1+ j)) ) (setq pt (list (car pt1) (cadr pt1) (+ (last pt1) (* j step)))) (command ".move" s2 "" pt pt1) (command ".rotate" s1 "" tam phando) ) ) (command ".rotate" s1 "" tam (- phando)) Bé m«n GCVL&DCCN - §å ¸n tèt nghiÖp - CTM K39 ;;------------------------------------------------------;; C:L¨NR¨NG - dïng ®Ó m« pháng qu¸ tr×nh gia c«ng ;; b»ng ph¬ng ph¸p bao h×nh ;; (dao phay l¨n r¨ng) ;;------------------------------------------------------(defun c:lanrang ( ) (command "undo" "m") (setvar "cmdecho" 0) (setq tam (getpoint "\nT©m quay cña ph«i: ") m (getreal "\nM«®un b¸nh r¨ng cÇn gia c«ng: ") z (getint "\nSè r¨ng b¸nh r¨ng: ") ) (princ "\n***********************************") (princ "\n H·y chän ph«i: ") (setq s1 (car (entsel))) (princ "\n H·y chän dao l¨n r¨ng (thanh r¨ng ®¹i diÖn): ") (setq s2 (car (entsel))) (setq pt1 '(0 0 0) step (getdist "\nBíc dÞch cña dao (theo X): ") Ngc (getint "\nSè lÇn dÞch dao ®Ó gia c«ng ®Þnh h×nh: ") pt2 (list (+ step (car pt1)) (cadr pt1) (last pt1)) ) (initget "C K") (setq ans (getkword "\nB¹n cã muèn t¹o ¶nh kh«ng ? /C: ")) (if (= "C" ans) (progn (initget) (setq i (getint "\nSè thø tù cña tÖp ¶nh ®Çu tiªn: ")) ) ) (setq Rc (/ (* m z) 2.0) gocquay (- (/ step Rc 1.0)) gocquay (/ (* gocquay 180) pi)) ) (repeat (1+ Ngc) (command ".copy" s2 "" "@" "@") (command "subtract" s1 "" "l" "") (if (= "C" ans) (progn (c:render) (c:saveimg (itoa (setq i (1+ i))) "gif") ) ) (command ".move" s2 "" pt1 pt2) (command ".rotate" s1 "" tam gocquay) ) (command ".move" s2 "" pt2 pt1) (command ".rotate" s1 "" tam (- gocquay))