;|
Shaft and Key DIN6885
- original October 2014
- add 3D October 2025
Create and Design by Songkhran Jongkul October 2014
Contact https://www.facebook.com/groups/AutolispTH"
|;
;;--------------create dialog------------------------+
(vl-load-com)
(defun create_sample ()
(setq fname (vl-filename-mktemp "sample.dcl"))
(setq fn (open fn
ame "w"))
(write-line " SAMPLE : dialog { "fn)
(write-line " label = \"Shaft & Key DIN6885\"; "fn)
(write-line " : column { "fn)
(write-line " : column { "fn)
(write-line " : image { "fn)
(write-line " alignment = centered; "fn)
(write-line " key = \"vectors\"; "fn)
(write-line " width = 33.26; "fn)
(write-line " height = 11.51; "fn)
(write-line " fixed_width = true; "fn)
(write-line " fixed_height = true; "fn)
(write-line " aspect_ratio = 1; "fn)
(write-line " color = -2; "fn)
(write-line " } "fn)
(write-line " } "fn)
(write-line " : boxed_column { "fn)
(write-line " label = \"Enter Dimension.\"; "fn)
(write-line " : edit_box { "fn)
(write-line " key = \"edit1\"; "fn)
(write-line " label = \"Diameter [mm.] :\"; "fn)
(write-line " edit_width = 5; "fn)
(write-line " value = \"\"; "fn)
(write-line " initial_focus = true; "fn)
(write-line " } "fn)
(write-line " : edit_box { "fn)
(write-line " key = \"edit2\"; "fn)
(write-line " label = \"Length [mm.] :\"; "fn)
(write-line " edit_width = 5; "fn)
(write-line " value = \"\"; "fn)
(write-line " } "fn)
(write-line " spacer; "fn)
(write-line " } "fn)
(write-line " : row { "fn)
(write-line " : button { "fn)
(write-line " key = \"accept\"; "fn)
(write-line " label = \" Okay \"; "fn)
(write-line " is_default = true; "fn)
(write-line " alignment = right; "fn)
(write-line " width = 5; "fn)
(write-line " } "fn)
(write-line " : button { "fn)
(write-line " key = \"cancel\"; "fn)
(write-line " label = \" Cancel \"; "fn)
(write-line " is_default = false; "fn)
(write-line " is_cancel = true; "fn)
(write-line " alignment = right; "fn)
(write-line " width = 5; "fn)
(write-line " } "fn)
(write-line " } "fn)
(write-line " : row { "fn)
(write-line " width = 15; "fn)
(write-line " fixed_width = true; "fn)
(write-line " : image { "fn)
(write-line " key = \"im\" ; "fn); //give it a name
(write-line " width = 9.92; "fn)
(write-line " height = 2.05; "fn)
(write-line " fixed_width = true; "fn)
(write-line " fixed_height = true; "fn)
(write-line " aspect_ratio = 1; "fn)
(write-line " color = -15; "fn);// -15 = no background, -2 = background
(write-line " alignment = right; "fn)
(write-line " } "fn)
(write-line " : paragraph { "fn)
(write-line " : text_part { "fn)
(write-line " label = \"FB.Group.AutolispTH\"; "fn)
(write-line " alignment = left; "fn)
(write-line " } "fn)
(write-line " : text_part { "fn)
(write-line " label = \"We Expert CAD.\"; "fn)
(write-line " alignment = left; "fn)
(write-line " } "fn)
(write-line " } "fn)
(write-line " } "fn)
(write-line " } "fn) ;;column
(write-line " } "fn) ;;Dialog
(close fn)
);defun
;;--------------------------------------------------------------+
(defun my_error (msg)
(if
(or
(= msg "Function cancelled")
(= msg "quit / exit abort")
)
(princ)
(princ (strcat "\nError: " msg))
)
(if msg (Alert (strcat "\nApplication error: " msg)))
(setq *error* old_error)
(setvar "cmdecho" old_cmdecho)
(setvar "osmode" old_osnap)
(princ)
);;end my_error
;;--------------------------------------------------------------+
(defun C:SHKEY(/ D1 lk)
;;-- create dialog .dcl in temp file. -----+
(create_sample)
(setq dcl_id (load_dialog fname))
(if (not Myage) (setq Myage "25")(if (= (type Myage) 'STR) T (setq Myage "25")))
(if (not Myname)(setq Myname "70")(if (= (type Myname) 'STR) T (setq Myname "70")))
(if (new_dialog "SAMPLE" dcl_id)
(progn
(set_tile "edit1" Myage)
(set_tile "edit2" Myname)
;;----------Singnature------------
(setq w (dimx_tile "im") ;get image tile width
h (dimy_tile "im") ;get image tile height
);setq
(start_image "im") ;start the image
(fill_image 0 0 w h -15) ;fill it with blue
(mapcar 'vector_image; Color 5
(list 52 32 26 18 11 9 8 8 8 9 16 17 16 13 8 6 0 0 1 5 8 9 8 3 1 0 0 0 4 10 45 45 47 50 54 57 59 59 52 52 50 48 47 46 45 45 38 32 45 18 26 26 32 32 26)
(list 26 26 16 0 21 20 19 18 18 17 11 6 3 1 0 0 1 1 7 6 6 6 9 14 16 19 19 22 25 26 3 3 1 0 0 1 3 7 9 7 6 6 7 9 11 11 4 0 0 0 0 9 12 12 16)
(list 59 45 26 26 18 11 9 8 9 16 17 17 17 16 13 8 6 1 5 8 9 9 9 8 3 1 0 4 10 26 45 47 50 54 57 59 59 59 52 52 52 50 48 47 46 45 38 45 45 18 26 32 38 38 32)
(list 26 26 26 0 21 21 20 19 17 11 9 9 6 3 1 0 0 7 6 6 6 8 8 9 14 16 22 25 26 26 4 1 0 0 1 3 7 26 26 9 7 6 6 7 9 26 21 0 4 21 9 0 4 21 26)
(list 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5)
);mapcar
(end_image)
;****************default image************************************
(setq x (dimx_tile "vectors")
y (dimy_tile "vectors")
)
(start_image "vectors");;Elbow
(fill_image 0 0 x y -2) ;fill it with blue
(mapcar 'vector_image; Color 3
(list 166 174 182 189 194 194 191 185 175 158 150 143 138 137 137 138 141 148 129 132 132 129 126 125 125 126 129 132 132 129 7 10 10 7 4 3 3 4 4 3 3 4 157 157 175 157 157 9 25 25 107 107 112 66 21 9 112 21 21 112 21 21 21 21 112 21 7 7 107 107 25 25)
(list 104 103 100 93 84 67 60 52 47 103 100 93 84 75 75 67 60 52 75 68 54 46 68 60 60 54 75 82 96 104 75 82 96 104 82 90 90 96 68 60 60 54 38 55 38 39 38 46 46 55 46 46 62 63 62 46 38 38 104 104 121 104 22 22 22 38 104 46 46 39 39 39)
(list 174 182 189 194 195 195 194 191 185 166 158 150 143 138 138 141 148 157 132 133 133 132 129 126 126 129 132 133 133 132 10 11 11 10 7 4 4 7 7 4 4 7 175 175 175 175 157 25 25 107 107 124 124 112 66 21 112 21 112 112 112 21 21 112 112 112 129 25 129 107 107 25)
(list 103 100 93 84 75 75 67 60 52 104 103 100 93 84 67 60 52 47 68 60 60 54 75 68 54 46 82 90 90 96 82 90 90 96 75 82 96 104 75 68 54 46 38 55 55 39 55 46 55 55 55 46 46 62 63 62 46 46 104 121 121 121 38 22 38 38 104 46 46 55 39 55)
(list 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3)
);mapcar
(mapcar 'vector_image; Color 1
(list 191 191 191 137 137 141 25 25 30 103 103 103 30 107 25 141 137 195)
(list 122 124 122 123 123 122 90 90 89 89 90 89 90 58 58 123 78 78)
(list 195 195 191 141 141 141 30 30 30 107 107 103 103 107 25 191 137 195)
(list 123 123 124 122 124 124 89 90 90 90 90 90 90 93 93 123 126 126)
(list 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
);mapcar
(mapcar 'vector_image; Color 2
(list 86 86 85 83 73 72 71 71 71 72 73 75 74 73 72 69 68 67 65 65 59 62 62 62 61 60 59 59 59 59 59 60 180 184 184 183 182 181 181 180 180 180 181 182 169 172 172 172 171 170 169 169 169 169 169 170 164 166 166 166 165 161 161 156 155 155 155 155 156 158 158 157 155 149 149 147 149 148 147 53 53 78 77 83 145 145 145 150 145 152 152 176 175 189 187 187 177 168 162 156 152 148 144 141 175 139 137 137 138 7 5 3 3 5 128 126 125 125 111 104 107 97 90 83 76 70 63 56 50 43 37 30 23 19 16 14 11 104 93 83 72 61 51 40 30 21 102 21 92 81 71 60 50 39 28 21 21)
(list 82 82 81 81 86 86 85 82 82 81 81 81 88 89 89 82 81 81 81 81 84 83 82 81 81 81 82 82 83 85 86 86 115 114 114 113 113 113 113 114 114 116 117 118 115 114 114 113 113 113 113 113 114 116 117 118 113 114 113 113 113 113 113 115 116 116 116 117 118 114 113 113 113 116 116 118 111 110 110 86 78 78 81 78 118 110 110 112 118 113 110 110 113 113 113 113 102 104 104 103 101 98 95 91 50 86 81 75 67 104 99 94 88 79 73 68 62 55 62 62 52 62 63 63 63 63 63 63 63 63 63 62 62 60 56 52 48 22 22 22 22 22 22 22 22 24 104 34 104 104 104 104 104 104 104 108 118)
(list 86 86 86 85 75 73 72 71 72 73 75 75 75 74 73 69 69 68 67 65 62 62 62 62 62 61 60 59 59 59 60 62 184 184 184 184 183 182 181 181 180 181 182 184 172 172 172 172 172 171 170 169 169 169 170 172 164 166 166 166 166 165 161 158 156 155 155 156 158 158 158 158 157 150 149 149 150 149 148 56 53 78 80 83 145 145 147 150 147 152 152 176 178 189 189 187 193 195 195 194 192 189 186 182 177 170 164 157 157 8 11 11 10 8 132 133 132 131 113 121 114 105 98 91 84 78 71 64 57 51 44 37 31 25 25 20 13 112 109 99 88 78 67 57 46 36 112 25 108 97 87 76 66 55 45 34 24)
(list 86 82 82 81 86 86 86 85 81 81 81 87 87 88 89 86 82 81 81 86 84 84 83 82 81 81 81 83 85 86 86 86 115 115 114 114 113 113 113 113 116 117 118 118 115 115 114 114 113 113 113 114 116 117 118 118 118 118 114 113 113 113 118 115 115 116 117 118 118 118 114 113 113 115 117 117 112 111 110 86 86 86 81 86 118 118 110 115 118 118 110 118 113 113 113 118 86 77 71 65 61 57 53 50 48 55 55 55 48 103 93 86 81 76 69 61 55 50 60 46 46 55 55 55 55 55 55 55 55 55 55 55 55 53 47 46 46 30 38 38 38 38 38 38 38 38 114 38 121 121 121 121 121 121 121 121 121)
(list 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2)
);mapcar
(mapcar 'vector_image; Color 252
(list 166 98 35 0)
(list 19 35 35 75)
(list 166 98 35 200)
(list 123 59 59 75)
(list 252 252 252 252)
);mapcar
(end_image)
(action_tile "edit1" "(setq Myage $value)")
(action_tile "edit2" "(setq Myname $value)")
(action_tile "accept" "(setq ddiag 2)(done_dialog)")
(action_tile "cancel" "(setq ddiag 1)(done_dialog)")
(start_dialog)
(unload_dialog dcl_id)
(if(= ddiag 1)(princ "\nShaft and Key DIN6885 cancelled!"))
(if(= ddiag 2)
(progn
;;;--- Multiply the users age x 365 to get the number of days.
(setq d1 (atof MyAge))
(setq lk (atof Myname))
(shaft)
)
)
)
(progn
(alert "Shaft and Key DIN6885 could not be loaded!")
(exit)
)
)
(princ)
)
;----------------draw polyline from list-----------------------------+
(defun LWPoly (lst cls lty clor)
(entmakex (append (list (cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 6 lty)
(cons 90 (length lst))
(cons 62 clor)
(cons 70 cls))
(mapcar (function (lambda (p) (cons 10 p))) lst)))
)
;--------------------------------------------------------------------+
(defun myCir (cen rad)
(entmakex
(list (cons 0 "CIRCLE")
(cons 10 cen)
(cons 40 (distance cen rad))
)
)
)
;;--------------create textstyle------------------------+
(defun mkstyle (stylename txth fontname)
;; RJP ? 2019-04-24
(entmake
(list
'(0 . "STYLE")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbTextStyleTableRecord")
(cons 2 stylename)
'(70 . 0)
(cons 40 txth)
'(41 . 1.0)
'(50 . 0.0)
'(71 . 0)
'(42 . 0.09375)
(cons 3 fontname)
'(4 . "")
)
)
)
;;--------------create layer------------------------+
(defun mylayer (lyname col)
(entmake (list
'(0 . "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2 lyname)
(cons 70 0)
(cons 62 col)
(cons 6 "Continuous")
)
)
)
(defun rtd (x) ;radial to degee
(/ (* x 180) pi)
)
(defun dtr (x) ;degee to radial
(* x (/ pi 180))
)
(defun shaft ()
(setq old_cmdecho (getvar "cmdecho"))
(setq old_layer (getvar "clayer"))
(setq old_osnap (getvar "osmode"))
(setq old_error *error*)
(setq *error* my_error )
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq tsname (getvar "textstyle"))
(setq lay (getvar "CLAYER" ))
(if (not (tblsearch "LAYER" "CenterLine"));;<=== Layer Name
(mylayer "CenterLine" 2)
)
(if (< d1 6.0) (progn (alert (strcat "Diameter of Shaft Min. 6.0 mm."))(exit)))
(if (> d1 130.0) (progn (alert (strcat "Diameter of Shaft Max. 130.0 mm."))(exit)))
(cond
((and(>= D1 6.0)(< D1 8.0))
(setq b 2.0 h 2.0 t1 1.2 t2 1.0 rt1 0.1 rt2 0.1 )
(if (or(< lk 6.0)(> lk 20.0))
(progn
(alert (strcat "Enter Lenght of key mm." "\n" "Min. 6.0 mm. Max. 20 mm."))
(setq lk 20.0)
)
)
);;6-8 d1
((and(>= D1 8.0)(< D1 10.0))
(setq b 3.0 h 3.0 t1 1.8 t2 1.6 rt1 0.1 rt2 0.1)
(if (or(< lk 6.0)(> lk 36.0))
(progn
(alert (strcat "Enter Lenght of key mm." "\n" "Min. 6.0 mm. Max. 36 mm."))
(setq lk 36.0)
)
)
);;8-10 d1
((and(>= D1 10.0)(< D1 12.0))
(setq b 4.0 h 4.0 t1 2.5 t2 1.8 rt1 0.1 rt2 0.1)
(if (or(< lk 8.0)(> lk 45.0))
(progn
(alert (strcat "Enter Lenght of key mm." "\n" "Min. 8.0 mm. Max. 45 mm."))
(setq lk 45.0)
)
)
);;10-12 d1
((and(>= D1 12.0)(< D1 17.0))
(setq b 5.0 h 5.0 t1 3.0 t2 2.3 rt1 0.2 rt2 0.2)
(if (or(< lk 10.0)(> lk 56.0))
(progn
(alert (strcat "Enter Lenght of key mm." "\n" "Min. 8.0 mm. Max. 45 mm."))
(setq lk 56.0)
)
)
);;12-17 d1
((and(>= D1 17.0)(< D1 22.0))
(setq b 6.0 h 6.0 t1 3.5 t2 2.8 rt1 0.2 rt2 0.2)
(if (or(< lk 14.0)(> lk 70.0))
(progn
(alert (strcat "Enter Lenght of key mm." "\n" "Min. 14.0 mm. Max. 70 mm."))
(setq lk 70.0)
)
)
);;17-22 d1
((and(>= D1 22.0)(< D1 30.0))
(setq b 8.0 h 7.0 t1 4.0 t2 3.3 rt1 0.2 rt2 0.2)
(if (or(< lk 18.0)(> lk 90.0))
(progn
(alert (strcat "Enter Lenght of key mm." "\n" "Min. 18.0 mm. Max. 90 mm."))
(setq lk 70.0)
)
)
);;22-30 d1
((and(>= D1 30.0)(< D1 38.0))
(setq b 10.0 h 8.0 t1 5.0 t2 3.3 rt1 0.2 rt2 0.2)
(if (or(< lk 20.0)(> lk 110.0))
(progn
(alert (strcat "Enter Lenght of key mm." "\n" "Min. 20.0 mm. Max. 110 mm."))
(setq lk 110.0)
)
)
);;30-38 d1
((and(>= D1 38.0)(< D1 44.0))
(setq b 12.0 h 8.0 t1 5.0 t2 3.3 rt1 0.2 rt2 0.2)
(if (or(< lk 28.0)(> lk 140.0))
(progn
(alert (strcat "Enter Lenght of key mm." "\n" "Min. 28.0 mm. Max. 140 mm."))
(setq lk 140.0)
)
)
);;38-44 d1
((and(>= D1 44.0)(< D1 50.0))
(setq b 14.0 h 9.0 t1 5.5 t2 3.8 rt1 0.2 rt2 0.2)
(if (or(< lk 36.0)(> lk 160.0))
(progn
(alert (strcat "Enter Lenght of key mm." "\n" "Min. 36.0 mm. Max. 160 mm."))
(setq lk 160.0)
)
)
);;44-50 d1
((and(>= D1 50.0)(< D1 58.0))
(setq b 16.0 h 10.0 t1 6.0 t2 4.3 rt1 0.2 rt2 0.2)
(if (or(< lk 45.0)(> lk 180.0))
(progn
(alert (strcat "Enter Lenght of key mm." "\n" "Min. 45.0 mm. Max. 180 mm."))
(setq lk 180.0)
)
)
);;50-58 d1
((and(>= D1 58.0)(< D1 65.0))
(setq b 18.0 h 11.0 t1 7.0 t2 4.4 rt1 0.2 rt2 0.2)
(if (or(< lk 50.0)(> lk 200.0))
(progn
(alert (strcat "Enter Lenght of key mm." "\n" "Min. 50.0 mm. Max. 200 mm."))
(setq lk 200.0)
)
)
);;58-65 d1
((and(>= D1 65.0)(< D1 75.0))
(setq b 20.0 h 12.0 t1 7.5 t2 4.9 rt1 0.2 rt2 0.2 )
(if (or(< lk 56.0)(> lk 220.0))
(progn
(alert (strcat "Enter Lenght of key mm." "\n" "Min. 56.0 mm. Max. 220 mm."))
(setq lk 220.0)
)
)
);;65-75 d1
((and(>= D1 75.0)(< D1 85.0))
(setq b 22.0 h 14.0 t1 9.0 t2 5.4 rt1 0.2 rt2 0.2)
(if (or(< lk 63.0)(> lk 250.0))
(progn
(alert (strcat "Enter Lenght of key mm." "\n" "Min. 63.0 mm. Max. 250 mm."))
(setq lk 250.0)
)
)
);;75-85 d1
((and(>= D1 85.0)(< D1 95.0))
(setq b 25.0 h 14.0 t1 9.0 t2 5.4 rt1 0.2 rt2 0.2)
(if (or(< lk 70.0)(> lk 280.0))
(progn
(alert (strcat "Enter Lenght of key mm." "\n" "Min. 70.0 mm. Max. 280 mm."))
(setq lk 280.0)
)
)
);;85-95 d1
((and(>= D1 95.0)(< D1 110.0))
(setq b 28.0 h 16.0 t1 10.0 t2 6.4 rt1 0.2 rt2 0.2 )
(if (or(< lk 80.0)(> lk 320.0))
(progn
(alert (strcat "Enter Lenght of key mm." "\n" "Min. 80.0 mm. Max. 320 mm."))
(setq lk 320.0)
)
)
);;95-110 d1
((and(>= D1 110.0)(<= D1 130.0))
(setq b 32.0 h 18.0 t1 11.0 t2 7.4 rt1 0.2 rt2 0.2)
(if (or(< lk 90.0)(> lk 360.0))
(progn
(alert (strcat "Enter Lenght of key mm." "\n" "Min. 90.0 mm. Max. 360 mm."))
(setq lk 360.0)
)
)
);;110-130 d1
);cond
;;(vl-cmdf "_style" "ISOCP" (/ b 4) "1" "0" "" "")
(if (not (tblsearch "Style" "SKN"))
(mkstyle "SKN" (/ b 4) "ISOCP")
)
(setq ang0 (DTR 0.0))
(setq ang1 (DTR 90.0))
(setq ang2 (DTR 180.0))
(setq ang3 (DTR 270.0))
(setq p1 (getpoint "\nPick Start Point : "))
(setq p2 (polar p1 ang1 (/ d1 2)))
(setq p2a (polar p1 ang0 (/ d1 2)))
(setq p2b (polar p1 ang2 (/ d1 2)))
(setq p2c (polar p1 ang3 (/ d1 2)))
(setq p2aa (polar p1 ang0 (+(/ d1 2) b)))
(setq p2aa1 (polar p1 ang0 (+(/ d1 2) (* b 2))))
(setq p2ab (polar p2aa ang2 (+ d1 (* b 2))))
(setq p2ac (polar p1 ang3 (+(/ d1 2) b)))
(setq p2ad (polar p2ac ang1 (+ (+ t2 d1) (* b 2))))
(setq p3 (polar p2 ang3 t1))
(setq p4 (polar p3 ang2 (/ b 2)))
(setq p5 (polar p4 ang1 h))
(setq p6 (polar p5 ang0 b))
(setq p7 (polar p6 ang3 h))
(setq p8 (polar p2 ang1 t2))
(setq p9 (polar p8 ang2 (/ b 2)))
(setq p10 (polar p9 ang0 b))
;;### Set point for front view ###
(setq f1 (polar p2b ang2 d1))
(setq f2 (polar f1 ang2 (* lk 2)))
(setq f3 (polar f2 ang0 (/ (* lk 2) 2))) ;;middle shaft
(setq f3a (polar f3 ang3 (/ d1 4)))
(setq f4 (list (car f3) (cadr p3)))
(setq f4a (polar f3 ang1 (/ d1 2)))
(setq f4b (polar f3 ang1 t2))
(setq f5 (polar f4 ang2 (/ lk 2)))
(setq f5a (polar f5 ang1 t1))
(setq f5b (list (+ (car f5)(/ b 2)) (- (cadr f5)(/ h 4))))
(setq f6 (polar f5 ang1 h))
(setq f6a (list (+ (car f6)(/ b 2)) (+ (cadr f6)(/ h 4))))
(setq f7 (polar f6 ang0 lk))
(setq f7a (list (- (car f7)(/ b 2)) (+ (cadr f7)(/ h 4))))
(setq f8 (polar f7 ang3 h))
(setq f8a (polar f8 ang1 t1))
(setq f8b (list (- (car f8)(/ b 2)) (- (cadr f8)(/ h 4))))
(setq f9 (polar f1 ang1 (/ d1 2)))
(setq f10 (polar f9 ang2 (/ h 4)))
(setq f10a (polar f9 ang3 (/ d1 4)))
(setq f10b (polar f10a ang2 (/ h 2)))
(setq f11 (polar f10 ang3 (/ d1 2)))
(setq f12 (polar f2 ang1 (/ d1 2)))
(setq f12a (polar f12 ang3 (/ d1 4)))
(setq f13 (polar f12 ang0 (/ h 4)))
(setq f14 (polar f13 ang3 (/ d1 2)))
(setq f15 (polar f2 ang3 (/ d1 2)))
(setq f15a (polar f2 ang3 (/ d1 4)))
(setq f15b (polar f15a ang0 (/ h 2)))
(setq f16 (polar f14 ang3 (/ d1 2)))
(setq f17 (polar f1 ang3 (/ d1 2)))
(setq f17a (polar f1 ang3 (/ d1 4)))
(setq f18 (polar f11 ang3 (/ d1 2)))
(setq f19 (polar f5a ang2 (/ h 4)))
(setq f20 (polar f19 ang1 t2))
(setq f21 (polar f8a ang0 (/ h 4)))
(setq f22 (polar f21 ang1 t2))
(setq f23 (polar f22 ang1 h))
(setq f24 (polar f20 ang1 h))
(setq f25 (polar f19 ang3 d1))
(setq f26 (polar f25 ang3 h))
(setq f27 (polar f21 ang3 d1))
(setq f28 (polar f27 ang3 h))
;;### Zoom point ###
(setq z1 (list (- (car f16) d1) (- (cadr f16)d1)))
(setq z2 (list (+ (car p2aa1) d1) (+ (cadr p2aa1) (* d1 2))))
;;### Broken Shaft ###
(setq b1 (polar f5a ang2 h))
(setq b2 (polar f19 ang3 h))
(setq b3 (polar f4 ang3 (/ h 2)))
(setq b4 (polar f21 ang3 h))
(setq b5 (polar f8a ang0 h))
(setq ftxt (polar f13 ang1 (* h 2)))
(setq ftxt1 (polar f16 ang3 (* h 2)))
(setq txt (strcat "Key Dimension : " "A" (rtos b 2 1) "x" (rtos h 2 1) "x" (rtos lk 2 1) " DIN 6885"))
(setq txt1 (strcat "Tolerance Depth Key : " "Shaft = " (rtos t1 2 1) " %%p" (rtos rt1 2 1) " ,Hub = " (rtos t2 2 1) " %%p" (rtos rt2 2 1)))
(vl-cmdf "_zoom" "w" z1 z2)
(vl-cmdf "_pline" f5 f6 f7 f8 "c")
(vl-cmdf "_pline" f8a f10 "")
(vl-cmdf "_pline" f5a f13 "")
(vl-cmdf "_pline" f16 f18 "")
(vl-cmdf "_pline" f20 f22 f23 f24 "c")
(vl-cmdf "-hatch" "S" "last" "" "Properties" "ANSI31" (/ b 6) 90 "")
(vl-cmdf "_pline" f25 f26 f28 f27 "c")
(vl-cmdf "-hatch" "S" "last" "" "Properties" "ANSI31" (/ b 6) 90 "")
(vl-cmdf "_pline" f19 f20 "")
(vl-cmdf "_pline" f21 f22 "")
(vl-cmdf "_pline" b1 b2 b3 b4 b5 f8a f8 f5 f5a "c")
(vl-cmdf "-hatch" "S" "last" "" "Properties" "ANSI31" (/ b 6) 0 "")
(vl-cmdf "_arc" f10 f10a f11)
(setq ssa1(ssname(ssget "L")0))
(vl-cmdf "_arc" f10 f10b f11)
(setq ssa2(ssname(ssget "L")0))
(vl-cmdf "_arc" f13 f12a f14)
(setq ssa3(ssname(ssget "L")0))
(vl-cmdf "_arc" f14 f15a f16)
(setq ssa4(ssname(ssget "L")0))
(vl-cmdf "_arc" f14 f15b f16)
(setq ssa5(ssname(ssget "L")0))
(vl-cmdf "_arc" f11 f17a f18)
(setq ssa6(ssname(ssget "L")0))
(setq pe (getvar 'PEDITACCEPT))
(setvar 'PEDITACCEPT 1)
(vl-cmdf "_.pedit" "_M" ssa1 ssa2 "" "_J" "" "")
(vl-cmdf "-hatch" "S" "last" "" "Properties" "ANSI31" (/ b 6) 0 "")
(vl-cmdf "_.pedit" "_M" ssa4 ssa5 "" "_J" "" "")
(vl-cmdf "-hatch" "S" "last" "" "Properties" "ANSI31" (/ b 6) 0 "")
(setvar 'PEDITACCEPT pe)
(myText "SKN" "bl" ftxt (/ b 4) 0 txt)
(myText "SKN" "bl" ftxt1 (/ b 4) 0 txt1)
;;### Draw Section Shaft and key ###
(vl-cmdf "_pline" p4 p5 p6 p7 "c")
(vl-cmdf "_circle" p1 (/ d1 2))
(vl-cmdf "_trim" "last" "" p6 "")
(vl-cmdf "_pline" p4 p5 p6 p7 "c")
(vl-cmdf "_trim" "last" "" p2 "")
(vl-cmdf "_erase" p5 "")
(vl-cmdf "_join" p4 p2a "")
(vl-cmdf "-hatch" "S" "last" "" "Properties" "ANSI31" (/ b 6) 0 "")
(vl-cmdf "_pline" p4 p5 p6 p7 "c")
(vl-cmdf "-hatch" "S" "Last" "" "Properties" "ANSI31" (/ b 6) 90 "")
(vl-cmdf "_pline" p5 p9 p10 p6 "")
(setvar "clayer" "CenterLine")
(vl-cmdf "_pline" f1 f2 "")
(setq ss1(ssname(ssget "L")0))
(vl-cmdf "_pline" f6a f5b "")
(setq ss2(ssname(ssget "L")0))
(vl-cmdf "_pline" f7a f8b "")
(setq ss3(ssname(ssget "L")0))
(vl-cmdf "_pline" p2aa p2ab "")
(setq ss4(ssname(ssget "L")0))
(vl-cmdf "_pline" p2ac p2ad "")
(setq ss5(ssname(ssget "L")0))
(vl-cmdf "_change" ss1 ss2 ss3 ss4 ss5 "" "Properties" "LType" "CENTER" "ltScale" t2 "")
(setvar "clayer" old_layer)
(princ)
;;### Draw Front View ###
(setvar "CLAYER" lay );;set to layer 0
(setvar "textstyle" tsname);;set textstyle to standard
(princ)
;;From Lines Tab:
(SETVAR "DIMCLRD" 1) ;Dimension line and leader color
(SETVAR "DIMCLRE" 1) ;Extension line color
(SETVAR "DIMEXE" (/ b 6)) ;Extension above dimension line
(SETVAR "DIMEXO" (/ b 6)) ;Extension line origin offset
;;From Symbols & Arrows Tab
(SETVAR "DIMBLK" ".") ;Arrow block name
(SETVAR "DIMBLK1" ".") ;First arrow block name
(SETVAR "DIMBLK2" ".") ;Second arrow block name
(SETVAR "DIMLDRBLK" ".") ;Leader block name
(SETVAR "DIMASZ" (/ b 4)) ;Arrow size
;;From Text Tab
(SETVAR "DIMTXSTY" "SKN") ;Text style
(SETVAR "DIMCLRT" 2) ;Dimension text color
(SETVAR "DIMTXT" (/ b 4)) ;Text height
(SETVAR "DIMTFAC" 1) ;Tolerance text height scaling factor
(SETVAR "DIMTAD" 1) ;Place text above the dimension line
(SETVAR "DIMGAP" (/ b 10)) ;Gap from dimension line to text
(SETVAR "DIMTIH" 0) ;Text inside extensions is horizontal
(SETVAR "DIMTOH" 1) ;Text outside horizontal
;;From Fit Tab
(SETVAR "DIMTMOVE" 1) ;Text movement
(SETVAR "DIMSCALE" 1.0000) ;Overall scale factor
;;From Primary Units Tab
(SETVAR "DIMLUNIT" 2) ;Linear unit format(2=decimal now) (4=Architectural)
(SETVAR "DIMDEC" 2) ;Decimal places 0.00
(SETVAR "DIMFRAC" 1) ;Fraction format
(SETVAR "DIMZIN" 3) ;Zero suppression
;;=== Dimension command
(vl-cmdf "_dimlinear" p4 p5 p2ab
"_dimlinear" p2a p2b p2ac
"_dimlinear" p5 p6 p2ad
"_dimlinear" p7 p2c p2aa
"_dimlinear" p10 p2c p2aa1
"_dimlinear" f5 f8 f3a
)
(s3d)
(princ)
(setq *error* old_error)
(setvar "OSMODE" old_osnap)
(setvar "clayer" old_layer)
(setvar "CMDECHO" old_cmdecho)
(princ)
)
;;(defun c:sk ()
;; (shaft)
;;)
;;(prompt "\nCreate and Design by Songkhran Jongkul October 2014")
;;(prompt "\nEnter SK to start.")
(prompt "\n\t\t\t +------------------------------------------+\n")
(prompt "\n\t\t\t | Start with SHKEY to execute. |\n")
(prompt "\n\t\t\t +------------------------------------------+\n")
(defun s3d ()
(setq pt1(polar f1 ang3 (* d1 2.0)))
(setq pt2(polar pt1 ang2 (* lk 2.0)))
(setvar "clayer" "CenterLine")
(vl-cmdf "_pline" pt1 pt2 "")
(setvar "clayer" old_layer)
(setq ss1(ssname(ssget "L")0))
(vl-cmdf "_circle" pt1 (/ d1 2))
(setq ss2(ssname(ssget "L")0))
(setq pt3 (list (-(car pt1)lk)(cadr pt1)(+(caddr pt1)(-(/ d1 2.0)t1))))
(setq pt4 (polar pt3 ang2 (-(/ lk 2.0)(/ b 2.0))))
(setq pt4a (polar pt4 ang3 (/ b 2.0)))
(setq pt4b (polar pt4 ang1 (/ b 2.0)))
(setq pt5 (polar pt3 ang0 (-(/ lk 2.0)(/ b 2.0))))
(setq pt5a (polar pt5 ang3 (/ b 2.0)))
(setq pt5b (polar pt5 ang1 (/ b 2.0)))
(setq pt6 (list (car pt4)(cadr pt4)(+(caddr pt4)(* h 2.0))))
(vl-cmdf "_pline" pt5a pt4a "a" pt4b "l" pt5b "a" pt5a "")
(setq ss3(ssname(ssget "L")0))
(vl-cmdf "_.EXTRUDE" ss3 "" h)
(setq ss4(ssname(ssget "L")0))
(vl-cmdf "_copy" ss4 "" pt4 pt6)
(vl-cmdf "_sweep" ss2 "" ss1)
(setq ss5(ssname(ssget "L")0))
(vl-cmdf "_subtract" ss5 "" ss4 "")
(princ)
)
;--------------------------------------------------------------------
(defun myText (txtStyle txtJust insertPt textHeight ang txtString)
;(myText tstyle "mc" ptxt txtH ang txt)
(if (= txtJust "M") (setq horJust 4 verJust 0));Middle
(if (= txtJust "L") (setq horJust 0 verJust 0));Left
(if (= txtJust "C") (setq horJust 1 verJust 0));Center
(if (= txtJust "R") (setq horJust 2 verJust 0));Right
(if (= txtJust "bl") (setq horJust 0 verJust 1));Bottom Left
(if (= txtJust "bc") (setq horJust 1 verJust 1));Bottom Center
(if (= txtJust "br") (setq horJust 2 verJust 1));Bottom Right
(if (= txtJust "tl") (setq horJust 0 verJust 3));Top Left
(if (= txtJust "tc") (setq horJust 1 verJust 3));Top Center
(if (= txtJust "tr") (setq horJust 2 verJust 3));Top Right
(if (= txtJust "ml") (setq horJust 0 verJust 2));Middle Left
(if (= txtJust "mc") (setq horJust 1 verJust 2));Middle Center
(if (= txtJust "mr") (setq horJust 2 verJust 2));Middle Right
(entmake
(list
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 7 txtStyle) ;Text style name
(cons 10 insertPt) ;First alignment point
(cons 11 insertPt) ;Second alignment point
(cons 40 textHeight);text Height
(cons 1 txtString) ;Default value (the string itself)
(cons 50 ang) ;Text rotation
(cons 71 0) ;Flags 0=Normal, 2=Backward, 4=Upside down
(cons 72 horJust) ;Horizontal text justification,0=Left,1=Center,2=Right,3=Aligin,4=Middle,5=Fit
(cons 73 verJust) ;Vertical text justification, 0=Baseline,1=Bottom,2=Middle,3=Top
)
)
)
ไม่มีความคิดเห็น:
แสดงความคิดเห็น