;;; TORVA LISP - Steel Section Draw (torva.kr/lisp.html) ;;; SHB : H-beam SIB : I-beam (tapered flange 1/6) SCH : channel (hot rolled) ;;; SAN : angle, equal and unequal (75x75, 125x75) SLC : lipped channel (light gauge) ;;; Type a size, pick center points, set the rotation for each. Enter ends. ;;; Each section is one closed polyline on the current layer, fillets drawn as arcs (bulge). ;;; Size: H x B (400x200) from the list = first match, or every dimension ;;; SHB HxBxt1xt2[xr] SIB/SCH HxBxt1xt2[xr1xr2] SAN AxBxt[xr1xr2] SLC HxBxCxt ;;; ? lists sizes. A leading H- I- C- L- is ignored ;;; Built-in lists: KS D 3502:2022 (H 95, I 20, channel 15, angle 53). SLC: common light gauge sizes, ;;; bend radius inside t, outside 2t ;;; Your own H sizes: tv_hbeam.txt on the support path, one per line "H B t1 t2 r" (same file as HBS) ;;; Center = middle of the outer box. Rotation 0 = web along UCS Y. Drawing unit: mm (vl-load-com) ;; KS D 3502:2022 H-beams (95) name H B t1 t2 r (setq *TV-SS-H* '( ("100x50x5x7" 100 50 5 7 8) ("100x100x6x8" 100 100 6 8 10) ("125x60x6x8" 125 60 6 8 9) ("125x125x6.5x9" 125 125 6.5 9 10) ("148x100x6x9" 148 100 6 9 11) ("150x75x5x7" 150 75 5 7 8) ("150x150x7x10" 150 150 7 10 11) ("175x90x5x8" 175 90 5 8 9) ("175x175x7.5x11" 175 175 7.5 11 12) ("194x150x6x9" 194 150 6 9 13) ("198x99x4.5x7" 198 99 4.5 7 11) ("200x100x5.5x8" 200 100 5.5 8 11) ("200x200x8x12" 200 200 8 12 13) ("200x204x12x12" 200 204 12 12 13) ("208x202x10x16" 208 202 10 16 13) ("244x175x7x11" 244 175 7 11 16) ("244x252x11x11" 244 252 11 11 16) ("248x124x5x8" 248 124 5 8 12) ("248x249x8x13" 248 249 8 13 16) ("250x125x6x9" 250 125 6 9 12) ("250x250x9x14" 250 250 9 14 16) ("250x255x14x14" 250 255 14 14 16) ("294x200x8x12" 294 200 8 12 18) ("294x302x12x12" 294 302 12 12 18) ("298x149x5.5x8" 298 149 5.5 8 13) ("298x201x9x14" 298 201 9 14 18) ("298x299x9x14" 298 299 9 14 18) ("300x150x6.5x9" 300 150 6.5 9 13) ("300x300x10x15" 300 300 10 15 18) ("300x305x15x15" 300 305 15 15 18) ("304x301x11x17" 304 301 11 17 18) ("310x305x15x20" 310 305 15 20 18) ("310x310x20x20" 310 310 20 20 18) ("336x249x8x12" 336 249 8 12 20) ("338x351x13x13" 338 351 13 13 20) ("340x250x9x14" 340 250 9 14 20) ("344x348x10x16" 344 348 10 16 20) ("344x354x16x16" 344 354 16 16 20) ("346x174x6x9" 346 174 6 9 14) ("350x175x7x11" 350 175 7 11 14) ("350x350x12x19" 350 350 12 19 20) ("350x357x19x19" 350 357 19 19 20) ("354x176x8x13" 354 176 8 13 14) ("388x402x15x15" 388 402 15 15 22) ("390x300x10x16" 390 300 10 16 22) ("394x398x11x18" 394 398 11 18 22) ("394x405x18x18" 394 405 18 18 22) ("396x199x7x11" 396 199 7 11 16) ("400x200x8x13" 400 200 8 13 16) ("400x400x13x21" 400 400 13 21 22) ("400x408x21x21" 400 408 21 21 22) ("406x403x16x24" 406 403 16 24 22) ("414x405x18x28" 414 405 18 28 22) ("428x407x20x35" 428 407 20 35 22) ("434x299x10x15" 434 299 10 15 24) ("440x300x11x18" 440 300 11 18 24) ("442x413x26x42" 442 413 26 42 22) ("446x199x8x12" 446 199 8 12 18) ("450x200x9x14" 450 200 9 14 18) ("452x416x29x47" 452 416 29 47 22) ("458x417x30x50" 458 417 30 50 22) ("462x419x32x52" 462 419 32 52 22) ("472x422x35x57" 472 422 35 57 22) ("482x300x11x15" 482 300 11 15 26) ("484x426x39x63" 484 426 39 63 22) ("488x300x11x18" 488 300 11 18 26) ("496x199x9x14" 496 199 9 14 20) ("498x432x45x70" 498 432 45 70 22) ("500x200x10x16" 500 200 10 16 20) ("506x201x11x19" 506 201 11 19 20) ("582x300x12x17" 582 300 12 17 28) ("588x300x12x20" 588 300 12 20 28) ("594x302x14x23" 594 302 14 23 28) ("596x199x10x15" 596 199 10 15 22) ("600x200x11x17" 600 200 11 17 22) ("606x201x12x20" 606 201 12 20 22) ("612x202x13x23" 612 202 13 23 22) ("692x300x13x20" 692 300 13 20 28) ("696x300x13x22" 696 300 13 22 28) ("700x300x13x24" 700 300 13 24 28) ("702x301x14x25" 702 301 14 25 28) ("708x302x15x28" 708 302 15 28 28) ("714x303x16x31" 714 303 16 31 28) ("792x300x14x22" 792 300 14 22 28) ("796x300x14x24" 796 300 14 24 28) ("800x300x14x26" 800 300 14 26 28) ("802x301x15x27" 802 301 15 27 28) ("808x302x16x30" 808 302 16 30 28) ("814x303x17x33" 814 303 17 33 28) ("890x299x15x23" 890 299 15 23 28) ("894x299x15x25" 894 299 15 25 28) ("900x300x16x28" 900 300 16 28 28) ("906x301x17x31" 906 301 17 31 28) ("912x302x18x34" 912 302 18 34 28) ("918x303x19x37" 918 303 19 37 28) )) ;; KS D 3502:2022 I-beams (20) name H B t1 t2 r1 r2 (setq *TV-SS-I* '( ("100x75x5x8" 100 75 5 8 7 3.5) ("125x75x5.5x9.5" 125 75 5.5 9.5 9 4.5) ("150x75x5.5x9.5" 150 75 5.5 9.5 9 4.5) ("150x125x8.5x14" 150 125 8.5 14 13 6.5) ("180x100x6x10" 180 100 6 10 10 5) ("200x100x7x10" 200 100 7 10 10 5) ("200x150x9x16" 200 150 9 16 15 7.5) ("250x125x7.5x12.5" 250 125 7.5 12.5 12 6) ("250x125x10x19" 250 125 10 19 21 10.5) ("300x150x8x13" 300 150 8 13 12 6) ("300x150x10x18.5" 300 150 10 18.5 19 9.5) ("300x150x11.5x22" 300 150 11.5 22 23 11.5) ("350x150x9x15" 350 150 9 15 13 6.5) ("350x150x12x24" 350 150 12 24 25 12.5) ("400x150x10x18" 400 150 10 18 17 8.5) ("400x150x12.5x25" 400 150 12.5 25 27 13.5) ("450x175x11x20" 450 175 11 20 19 9.5) ("450x175x13x26" 450 175 13 26 27 13.5) ("600x190x13x25" 600 190 13 25 25 12.5) ("600x190x16x35" 600 190 16 35 38 19) )) ;; KS D 3502:2022 channels (15) name H B t1 t2 r1 r2 (setq *TV-SS-C* '( ("75x40x5x7" 75 40 5 7 8 4) ("100x50x5x7.5" 100 50 5 7.5 8 4) ("125x65x6x8" 125 65 6 8 8 4) ("150x75x6.5x10" 150 75 6.5 10 10 5) ("150x75x9x12.5" 150 75 9 12.5 15 7.5) ("180x75x7x10.5" 180 75 7 10.5 11 5.5) ("200x80x7.5x11" 200 80 7.5 11 12 6) ("200x90x8x13.5" 200 90 8 13.5 14 7) ("250x90x9x13" 250 90 9 13 14 7) ("250x90x11x14.5" 250 90 11 14.5 17 8.5) ("300x90x9x13" 300 90 9 13 14 7) ("300x90x10x15.5" 300 90 10 15.5 19 9.5) ("300x90x12x16" 300 90 12 16 19 9.5) ("380x100x10.5x16" 380 100 10.5 16 18 9) ("380x100x13x20" 380 100 13 20 24 12) )) ;; KS D 3502:2022 angles, equal (40) then unequal (13) name A B t r1 r2 (setq *TV-SS-L* '( ("25x25x3" 25 25 3 4 2) ("30x30x3" 30 30 3 4 2) ("40x40x3" 40 40 3 4.5 2) ("40x40x5" 40 40 5 4.5 3) ("45x45x4" 45 45 4 6.5 3) ("50x50x4" 50 50 4 6.5 3) ("50x50x6" 50 50 6 6.5 4.5) ("60x60x4" 60 60 4 6.5 3) ("60x60x5" 60 60 5 6.5 3) ("60x60x6" 60 60 6 6.5 4.5) ("65x65x6" 65 65 6 8.5 4) ("65x65x8" 65 65 8 8.5 6) ("70x70x6" 70 70 6 8.5 4) ("75x75x6" 75 75 6 8.5 4) ("75x75x9" 75 75 9 8.5 6) ("75x75x12" 75 75 12 8.5 6) ("80x80x6" 80 80 6 8.5 4) ("80x80x7" 80 80 7 8.5 4) ("90x90x6" 90 90 6 10 5) ("90x90x7" 90 90 7 10 5) ("90x90x10" 90 90 10 10 7) ("90x90x13" 90 90 13 10 7) ("100x100x7" 100 100 7 10 5) ("100x100x10" 100 100 10 10 7) ("100x100x13" 100 100 13 10 7) ("120x120x8" 120 120 8 12 5) ("130x130x9" 130 130 9 12 6) ("130x130x12" 130 130 12 12 8.5) ("130x130x15" 130 130 15 12 8.5) ("150x150x10" 150 150 10 14 7) ("150x150x12" 150 150 12 14 7) ("150x150x15" 150 150 15 14 10) ("150x150x19" 150 150 19 14 10) ("175x175x12" 175 175 12 15 11) ("175x175x15" 175 175 15 15 11) ("200x200x15" 200 200 15 17 12) ("200x200x20" 200 200 20 17 12) ("200x200x25" 200 200 25 17 12) ("250x250x25" 250 250 25 24 12) ("250x250x35" 250 250 35 24 18) ("90x75x9" 90 75 9 8.5 6) ("100x75x7" 100 75 7 10 5) ("100x75x10" 100 75 10 10 7) ("125x75x7" 125 75 7 10 5) ("125x75x10" 125 75 10 10 7) ("125x75x13" 125 75 13 10 7) ("125x90x10" 125 90 10 10 7) ("125x90x13" 125 90 13 10 7) ("150x90x9" 150 90 9 12 6) ("150x90x12" 150 90 12 12 8.5) ("150x100x9" 150 100 9 12 6) ("150x100x12" 150 100 12 12 8.5) ("150x100x15" 150 100 15 12 8.5) )) ;; lipped channels, light gauge (31) name H B C t (setq *TV-SS-LC* '( ("60x30x10x1.6" 60 30 10 1.6) ("60x30x10x2.0" 60 30 10 2.0) ("60x30x10x2.3" 60 30 10 2.3) ("75x45x15x1.6" 75 45 15 1.6) ("75x45x15x2.0" 75 45 15 2.0) ("75x45x15x2.3" 75 45 15 2.3) ("90x45x20x2.0" 90 45 20 2.0) ("90x45x20x2.3" 90 45 20 2.3) ("90x45x20x3.2" 90 45 20 3.2) ("90x50x20x3.2" 90 50 20 3.2) ("100x50x20x1.6" 100 50 20 1.6) ("100x50x20x2.0" 100 50 20 2.0) ("100x50x20x2.3" 100 50 20 2.3) ("100x50x20x2.6" 100 50 20 2.6) ("100x50x20x3.2" 100 50 20 3.2) ("125x50x20x2.0" 125 50 20 2.0) ("125x50x20x2.3" 125 50 20 2.3) ("125x50x20x3.2" 125 50 20 3.2) ("150x50x20x3.2" 150 50 20 3.2) ("150x65x20x3.2" 150 65 20 3.2) ("150x65x20x4.0" 150 65 20 4.0) ("150x65x20x4.5" 150 65 20 4.5) ("150x75x25x3.2" 150 75 25 3.2) ("200x75x20x3.2" 200 75 20 3.2) ("200x75x20x4.5" 200 75 20 4.5) ("200x75x20x5.0" 200 75 20 5.0) ("200x75x25x3.2" 200 75 25 3.2) ("200x75x25x4.0" 200 75 25 4.0) ("200x75x25x4.5" 200 75 25 4.5) ("200x80x20x4.0" 200 80 20 4.0) ("200x80x20x4.5" 200 80 20 4.5) )) (if (null *TV-SS-LAST*) (setq *TV-SS-LAST* '(("H" . "400x200") ("I" . "300x150") ("C" . "150x75") ("L" . "75x75") ("LC" . "100x50x20x2.3")))) (if (null *TV-SS-ANG*) (setq *TV-SS-ANG* 0.0)) ;; kind -> (table min-count max-count label dimension-hint) (defun tv-ss-spec (k) (cond ((= k "H") (list *TV-SS-H* 4 5 "H-" "HxBxt1xt2")) ((= k "I") (list *TV-SS-I* 4 6 "I-" "HxBxt1xt2")) ((= k "C") (list *TV-SS-C* 4 6 "C-" "HxBxt1xt2")) ((= k "L") (list *TV-SS-L* 3 5 "L-" "AxBxt")) ((= k "LC") (list *TV-SS-LC* 4 4 "C-" "HxBxCxt"))) ) ;; "8x13" -> (8.0 13.0); nil if any part is not a positive number (defun tv-ss-nums (s / out tok c i v ok) (setq s (strcat s "x") tok "" ok T i 1) (while (<= i (strlen s)) (setq c (substr s i 1)) (if (= c "x") (progn (if (/= tok "") (if (and (setq v (distof tok 2)) (> v 0)) (setq out (cons v out)) (setq ok nil))) (setq tok "")) (setq tok (strcat tok c))) (setq i (1+ i))) (if ok (reverse out)) ) (defun tv-ss-fmt (v) (if (equal v (fix v) 1e-9) (itoa (fix v)) (rtos v 2 1))) ;; typed dimensions -> table row, nil if the count is wrong or the shape is impossible (defun tv-ss-row (k n / sp a b c d) (setq sp (tv-ss-spec k)) (if (and n (<= (cadr sp) (length n) (caddr sp))) (progn (while (< (length n) (caddr sp)) (setq n (append n '(0.0)))) (setq a (nth 0 n) b (nth 1 n) c (nth 2 n) d (nth 3 n)) (if (cond ((= k "H") (and (< c b) (< (* 2 d) a))) ((= k "I") (and (< c b) (> (- d (/ (- b c) 24.0)) 0) (< (* 2 (+ d (/ (- b c) 24.0))) a))) ((= k "C") (and (< c b) (< (* 2 d) a))) ((= k "L") (and (< c a) (< c b))) ((= k "LC") (and (< (* 2 d) c) (< (* 2 c) a) (< (* 3 d) b)))) (cons (strcat (tv-ss-fmt a) "x" (tv-ss-fmt b) "x" (tv-ss-fmt c) (if (= k "L") "" (strcat "x" (tv-ss-fmt d)))) n)))) ) ;; tv_hbeam.txt -> H rows put ahead of the built-in list (defun tv-ss-load (/ f fh ln row rows) (if (setq f (findfile "tv_hbeam.txt")) (progn (setq fh (open f "r")) (while (setq ln (read-line fh)) (setq ln (vl-string-trim " \t" ln)) (if (and (/= ln "") (/= (substr ln 1 1) ";") (setq row (tv-ss-row "H" (tv-ss-nums (vl-string-translate " \t,*X" "xxxxx" ln))))) (setq rows (cons row rows)))) (close fh) (setq *TV-SS-H* (append (reverse rows) *TV-SS-H*)))) ) (tv-ss-load) ;; "H-400*200" -> first list row starting with it; all dimensions not in the list -> new row (defun tv-ss-find (k s / r) (setq s (vl-string-translate "*X" "xx" (strcase s T))) (while (and (/= s "") (not (wcmatch (substr s 1 1) "#")) (/= (substr s 1 1) ".")) (setq s (substr s 2))) (foreach row (car (tv-ss-spec k)) (if (and (null r) (/= s "") (or (= s (car row)) (wcmatch (car row) (strcat s "x*")))) (setq r row))) (if (null r) (setq r (tv-ss-row k (tv-ss-nums s)))) r ) (defun tv-ss-list (k / i) (setq i 0) (foreach row (car (tv-ss-spec k)) (if (= 0 (rem i 4)) (princ "\n")) (princ (substr (strcat (car row) " ") 1 18)) (setq i (1+ i))) ) ;; size prompt; ? prints the list, Enter = last size (defun tv-ss-ask (k / s row last) (setq last (cdr (assoc k *TV-SS-LAST*))) (while (null row) (setq s (getstring (strcat "\n규격 [목록(?)] <" last ">: "))) (cond ((= s "") (setq s last)) ((= s "?") (tv-ss-list k) (setq s nil))) (if s (if (setq row (tv-ss-find k s)) (setq *TV-SS-LAST* (subst (cons k s) (assoc k *TV-SS-LAST*) *TV-SS-LAST*)) (princ (strcat "\nNo size " s ". Type ? for the list, or " (nth 4 (tv-ss-spec k))))))) row ) ;; corner P between A and B rounded with radius r -> (start end bulge) (defun tv-ss-fillet (P A B r / ux uy vx vy la lb dot th tl bg) (setq ux (- (car A) (car P)) uy (- (cadr A) (cadr P)) vx (- (car B) (car P)) vy (- (cadr B) (cadr P)) la (sqrt (+ (* ux ux) (* uy uy))) lb (sqrt (+ (* vx vx) (* vy vy)))) (if (or (equal la 0.0 1e-9) (equal lb 0.0 1e-9)) (list P P 0.0) (progn (setq ux (/ ux la) uy (/ uy la) vx (/ vx lb) vy (/ vy lb) dot (max -1.0 (min 1.0 (+ (* ux vx) (* uy vy)))) th (atan (sqrt (- 1.0 (* dot dot))) dot) tl (/ r (/ (sin (/ th 2.0)) (cos (/ th 2.0)))) bg (/ (sin (/ (- pi th) 4.0)) (cos (/ (- pi th) 4.0)))) (if (> (- (* ux vy) (* uy vx)) 0.0) (setq bg (- bg))) (list (list (+ (car P) (* ux tl)) (+ (cadr P) (* uy tl))) (list (+ (car P) (* vx tl)) (+ (cadr P) (* vy tl))) bg)) ) ) ;; (x y r) list -> polyline vertices (x y bulge), r > 0 corners rounded (defun tv-ss-round (pl / n i cur fl res) (setq n (length pl) i 0) (while (< i n) (setq cur (nth i pl)) (if (> (caddr cur) 1e-9) (progn (setq fl (tv-ss-fillet cur (nth (rem (+ i n -1) n) pl) (nth (rem (1+ i) n) pl) (caddr cur))) (setq res (cons (list (car (car fl)) (cadr (car fl)) (caddr fl)) res) res (cons (list (car (cadr fl)) (cadr (cadr fl)) 0.0) res))) (setq res (cons (list (car cur) (cadr cur) 0.0) res))) (setq i (1+ i))) (reverse res) ) ;; outline around (0,0), counterclockwise, (x y fillet-radius) (defun tv-ss-outline (k row / n h b t1 t2 r1 r2 hw bw tw x0 y0 te tr ri ro) (setq n (cdr row) h (float (nth 0 n)) b (float (nth 1 n)) t1 (float (nth 2 n)) t2 (float (nth 3 n)) hw (/ h 2.0) bw (/ b 2.0) tw (/ t1 2.0) x0 (- bw) y0 (- hw)) (cond ((= k "H") (setq r1 (float (nth 4 n))) (list (list x0 y0 0.0) (list bw y0 0.0) (list bw (+ y0 t2) 0.0) (list tw (+ y0 t2) r1) (list tw (- hw t2) r1) (list bw (- hw t2) 0.0) (list bw hw 0.0) (list x0 hw 0.0) (list x0 (- hw t2) 0.0) (list (- tw) (- hw t2) r1) (list (- tw) (+ y0 t2) r1) (list x0 (+ y0 t2) 0.0))) ((= k "I") ;; flange slope 1/6, t2 is the thickness at (B - t1)/4 from the toe (setq r1 (float (nth 4 n)) r2 (float (nth 5 n)) te (- t2 (/ (- b t1) 24.0)) tr (+ t2 (/ (- b t1) 24.0))) (list (list x0 y0 0.0) (list bw y0 0.0) (list bw (+ y0 te) r2) (list tw (+ y0 tr) r1) (list tw (- hw tr) r1) (list bw (- hw te) r2) (list bw hw 0.0) (list x0 hw 0.0) (list x0 (- hw te) r2) (list (- tw) (- hw tr) r1) (list (- tw) (+ y0 tr) r1) (list x0 (+ y0 te) r2))) ((= k "C") ;; web on the left, flanges to the right (setq r1 (float (nth 4 n)) r2 (float (nth 5 n))) (list (list x0 y0 0.0) (list bw y0 0.0) (list bw (+ y0 t2) r2) (list (+ x0 t1) (+ y0 t2) r1) (list (+ x0 t1) (- hw t2) r1) (list bw (- hw t2) r2) (list bw hw 0.0) (list x0 hw 0.0))) ((= k "L") ;; heel bottom left, leg A up, leg B to the right; t1 = t, t2 = r1 (setq r1 t2 r2 (float (nth 4 n))) (list (list x0 y0 0.0) (list bw y0 0.0) (list bw (+ y0 t1) r2) (list (+ x0 t1) (+ y0 t1) r1) (list (+ x0 t1) hw r2) (list x0 hw 0.0))) ((= k "LC") ;; web on the left, lips folded in; t1 = C, t2 = t, bends inside t, outside 2t (setq ri t2 ro (* 2.0 t2)) (list (list x0 y0 ro) (list bw y0 ro) (list bw (+ y0 t1) 0.0) (list (- bw t2) (+ y0 t1) 0.0) (list (- bw t2) (+ y0 t2) ri) (list (+ x0 t2) (+ y0 t2) ri) (list (+ x0 t2) (- hw t2) ri) (list (- bw t2) (- hw t2) ri) (list (- bw t2) (- hw t1) 0.0) (list bw (- hw t1) 0.0) (list bw hw ro) (list x0 hw ro)))) ) ;; closed polyline at UCS point p, turned by ang in the UCS plane (defun tv-ss-make (k row p ang / nv ca sa dxf o z) (setq nv (trans '(0 0 1) 1 0 T) ca (cos ang) sa (sin ang)) (foreach v (tv-ss-round (tv-ss-outline k row)) (setq o (trans (list (+ (car p) (- (* (car v) ca) (* (cadr v) sa))) (+ (cadr p) (+ (* (car v) sa) (* (cadr v) ca))) (caddr p)) 1 nv) z (caddr o) dxf (cons (cons 42 (caddr v)) (cons (list 10 (car o) (cadr o)) dxf)))) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (/ (length dxf) 2)) '(70 . 1) (cons 38 z)) (reverse dxf) (list (cons 210 nv)))) (entlast) ) (defun tv-ss-run (k / *error* old ce row label p e a n undo) (setq ce (getvar "CMDECHO") old *error*) (defun *error* (msg) (if undo (command "_.UNDO" "_E")) (setvar "CMDECHO" ce) (setq *error* old) (if (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*")) (princ (strcat "\nError: " msg))) (princ)) (setvar "CMDECHO" 0) (if (setq row (tv-ss-ask k)) (progn (setq label (strcat (nth 3 (tv-ss-spec k)) (car row)) n 0) (princ (strcat "\n" label)) (while (setq p (getpoint "\n중심점: ")) (if (not undo) (progn (command "_.UNDO" "_BE") (setq undo T))) (setq e (tv-ss-make k row p *TV-SS-ANG*) a (getangle p (strcat "\n회전 각도 <" (angtos *TV-SS-ANG*) ">: "))) (if (and a (not (equal a *TV-SS-ANG* 1e-9))) (progn (entdel e) (setq *TV-SS-ANG* a) (tv-ss-make k row p a))) (setq n (1+ n))) (if undo (command "_.UNDO" "_E")) (if (> n 0) (princ (strcat "\n" (itoa n) " x " label " drawn"))))) (setvar "CMDECHO" ce) (setq *error* old) (princ) ) (defun c:SHB () (tv-ss-run "H")) (defun c:SIB () (tv-ss-run "I")) (defun c:SCH () (tv-ss-run "C")) (defun c:SAN () (tv-ss-run "L")) (defun c:SLC () (tv-ss-run "LC")) (princ "\nTORVA Steel Section: SHB SIB SCH SAN SLC | torva.kr") (princ) ;;; ---- TVKEY: change a shortcut - shared by every TORVA LISP (torva.kr/lisp.html) ---- ;;; TVKEY -> command -> new shortcut. The original command keeps working ;;; Shortcuts are saved on this PC as TORVA-KEYS and restored whenever a TORVA LISP loads ;;; (Every TORVA LISP carries this block; loading several just redefines the same functions) ;; "A1=PY;B2=CN;" -> (("A1" . "PY") ("B2" . "CN")) (defun tv-key-list (/ s i out) (setq s (cond ((getenv "TORVA-KEYS")) ("")) out nil) (while (setq i (vl-string-search ";" s)) (setq out (cons (substr s 1 i) out) s (substr s (+ i 2)))) (if (/= s "") (setq out (cons s out))) (vl-remove nil (mapcar '(lambda (x / j) (if (setq j (vl-string-search "=" x)) (cons (substr x 1 j) (substr x (+ j 2))))) (reverse out)))) (defun tv-key-save (lst) (setenv "TORVA-KEYS" (apply 'strcat (mapcar '(lambda (p) (strcat (car p) "=" (cdr p) ";")) lst)))) ;; is cmd a loaded LISP command (defun tv-key-cmd-p (cmd) (member (type (eval (read (strcat "C:" cmd)))) '(SUBR USUBR EXRXSUBR))) (defun tv-key-def (key cmd) (eval (list 'defun (read (strcat "C:" key)) '() (list (read (strcat "C:" cmd))) '(princ)))) ;; is key an alias in acad.pgp ("L, *LINE") (defun tv-key-pgp-p (key / f h l hit) (if (setq f (findfile "acad.pgp")) (progn (setq h (open f "r")) (while (and (not hit) (setq l (read-line h))) (if (and (not (wcmatch l ";*")) (wcmatch (strcase l) (strcat key ",*"))) (setq hit T))) (close h))) hit) ;; reason the key cannot be used, nil if fine (defun tv-key-bad (key lst) (cond ((not (vl-every '(lambda (c) (or (<= 48 c 57) (<= 65 c 90))) (vl-string->list key))) "영문·숫자만") ((getcname key) "AutoCAD 명령 이름") ((tv-key-pgp-p key) "acad.pgp 별칭과 같음") ((and (tv-key-cmd-p key) (not (assoc key lst))) "이미 있는 리습 명령"))) ;; "My shortcuts" lines at the end of the file: (tv-my-key "A1" "BN"). Bad key -> reason only (defun tv-my-key (key cmd / why) (setq key (strcase key) cmd (strcase cmd)) (cond ((not (tv-key-cmd-p cmd))) ((setq why (tv-key-bad key (list (cons key cmd)))) (princ (strcat "\nShortcut " key ": " why))) (T (tv-key-def key cmd)))) (defun c:TVKEY (/ cmd key lst why) (setq lst (tv-key-list) cmd (strcase (getstring "\n단축키를 붙일 명령 [목록(?)]: "))) (cond ((= cmd "")) ((= cmd "?") (if lst (foreach p lst (princ (strcat "\n " (car p) " = " (cdr p)))) (princ "\nNo shortcuts set"))) ((not (tv-key-cmd-p cmd)) (princ (strcat "\n" cmd " is not a loaded LISP command"))) (T (setq key (strcase (getstring (strcat "\n" cmd " 의 새 단축키 [지우기(-)]: ")))) (cond ((= key "")) ((= key "-") (foreach p lst (if (= (cdr p) cmd) (set (read (strcat "C:" (car p))) nil))) (tv-key-save (vl-remove-if '(lambda (p) (= (cdr p) cmd)) lst)) (princ (strcat "\nShortcut for " cmd " removed"))) ((= key cmd)) ((setq why (tv-key-bad key lst)) (princ (strcat "\n" key ": " why))) (T (tv-key-save (cons (cons key cmd) (vl-remove-if '(lambda (p) (= (car p) key)) lst))) (tv-key-def key cmd) (princ (strcat "\n" key " now runs " cmd)))))) (princ)) ;; on load: restore saved shortcuts whose command is loaded (foreach p (tv-key-list) (if (tv-key-cmd-p (cdr p)) (tv-key-def (car p) (cdr p)))) (princ "\nTVKEY: change a shortcut | torva.kr") (princ) ;;; ---- My shortcuts: lines set at torva.kr download land below. Edit or add lines to change them ----