;;; TORVA LISP - H-Beam Section Swap (torva.kr/lisp.html) ;;; HBS : pick H-beam section polylines, type a size (400x200) -> each is redrawn ;;; at that size, same center and angle, web fillets included ;;; Size: H x B (400x200) from the list, or any H x B x t1 x t2 [x r] (400x200x8x13x16). ? lists sizes ;;; Your own sizes: tv_hbeam.txt on the support path, one per line "H B t1 t2 r" (r optional, ; = comment). ;;; Those rows come before the built-in list ;;; Properties (layer, color, linetype) are copied from the old polyline. Locked layers are skipped ;;; Drawing unit: mm (vl-load-com) ;; built-in list: KS D 3502:2022 H-beams (95), name H B t1 t2 r (setq *TV-HBEAM-TABLE* '( ("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) )) (if (null *TV-HBEAM-LAST*) (setq *TV-HBEAM-LAST* "400x200")) ;; "8x13" -> (8.0 13.0); nil if any part is not a positive number (defun tv-hbeam-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-hbeam-fmt (v) (if (equal v (fix v) 1e-9) (itoa (fix v)) (rtos v 2 1))) ;; (H B t1 t2 [r]) -> table row, nil if the shape is impossible (defun tv-hbeam-row (n) (if (and (<= 4 (length n) 5) (< (nth 2 n) (nth 1 n)) (< (* 2 (nth 3 n)) (car n))) (list (strcat (tv-hbeam-fmt (nth 0 n)) "x" (tv-hbeam-fmt (nth 1 n)) "x" (tv-hbeam-fmt (nth 2 n)) "x" (tv-hbeam-fmt (nth 3 n))) (nth 0 n) (nth 1 n) (nth 2 n) (nth 3 n) (if (nth 4 n) (nth 4 n) 0.0))) ) ;; tv_hbeam.txt -> rows put ahead of the built-in list (defun tv-hbeam-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-hbeam-row (tv-hbeam-nums (vl-string-translate " \t,*X" "xxxxx" ln))))) (setq rows (cons row rows)))) (close fh) (setq *TV-HBEAM-TABLE* (append (reverse rows) *TV-HBEAM-TABLE*)) (princ (strcat "\n" (itoa (length rows)) " sizes from " f)))) ) (tv-hbeam-load) ;; "H-400*200" -> list row; full "400x200x8x13[x16]" not in the list -> new row; else nil (defun tv-hbeam-find (s / r) (setq s (vl-string-translate "*X" "xx" (strcase s T))) (if (wcmatch s "h-*") (setq s (substr s 3))) (if (wcmatch s "h#*") (setq s (substr s 2))) (foreach row *TV-HBEAM-TABLE* (if (and (null r) (or (= s (car row)) (wcmatch (car row) (strcat s "x*")))) (setq r row))) (if (null r) (setq r (tv-hbeam-row (tv-hbeam-nums s)))) r ) (defun tv-hbeam-list (/ i) (setq i 0) (foreach row *TV-HBEAM-TABLE* (if (= 0 (rem i 4)) (princ "\n")) (princ (substr (strcat (car row) " ") 1 17)) (setq i (1+ i))) ) ;; size prompt; ? prints the list, Enter = last size (defun tv-hbeam-ask (/ s row) (while (null row) (setq s (getstring (strcat "\n규격 H×B 또는 H×B×t1×t2 [목록(?)] <" *TV-HBEAM-LAST* ">: "))) (cond ((= s "") (setq s *TV-HBEAM-LAST*)) ((= s "?") (tv-hbeam-list) (setq s nil))) (if s (if (setq row (tv-hbeam-find s)) (setq *TV-HBEAM-LAST* s) (princ (strcat "\nNo size " s ". Type ? for the list, or H x B x t1 x t2"))))) row ) ;; polyline -> (center rotation); rotation 0 = flanges along X (defun tv-hbeam-frame (ent / vs a1 vr minx maxx miny maxy dx horiz cx cy) (foreach x (entget ent) (if (= (car x) 10) (setq vs (append vs (list (cdr x)))))) (if (>= (length vs) 2) (progn (setq a1 (angle (car vs) (cadr vs))) (while (>= a1 (/ pi 2.0)) (setq a1 (- a1 (/ pi 2.0)))) (while (< a1 0.0) (setq a1 (+ a1 (/ pi 2.0)))) ;; undo the tilt so edges are orthogonal (setq vr (mapcar '(lambda (p) (list (+ (* (car p) (cos a1)) (* (cadr p) (sin a1))) (- (* (cadr p) (cos a1)) (* (car p) (sin a1))))) vs)) (setq minx (apply 'min (mapcar 'car vr)) maxx (apply 'max (mapcar 'car vr)) miny (apply 'min (mapcar 'cadr vr)) maxy (apply 'max (mapcar 'cadr vr)) dx (- maxx minx)) ;; a horizontal edge almost as long as the width = flange along X (mapcar '(lambda (p q) (if (and (< (abs (- (cadr p) (cadr q))) 1.0) (> (abs (- (car p) (car q))) (* dx 0.8))) (setq horiz T))) vr (append (cdr vr) (list (car vr)))) (setq cx (/ (+ minx maxx) 2.0) cy (/ (+ miny maxy) 2.0)) (list (list (- (* cx (cos a1)) (* cy (sin a1))) (+ (* cx (sin a1)) (* cy (cos a1)))) (if horiz a1 (+ a1 (/ pi 2.0))))) ) ) ;; corner P between A and B rounded with radius r -> (start end bulge) (defun tv-hbeam-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 -> lwpolyline vertices (x y bulge), r > 0 corners rounded (defun tv-hbeam-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-hbeam-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) ) (defun tv-hbeam-make (c row / cx cy hw bw tw t2 r dxf) (setq cx (car c) cy (cadr c) hw (/ (nth 1 row) 2.0) bw (/ (nth 2 row) 2.0) tw (/ (nth 3 row) 2.0) t2 (nth 4 row) r (nth 5 row)) (setq dxf (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 0) '(70 . 1))) (foreach v (tv-hbeam-round (list (list (- cx bw) (- cy hw) 0.0) (list (+ cx bw) (- cy hw) 0.0) (list (+ cx bw) (+ (- cy hw) t2) 0.0) (list (+ cx tw) (+ (- cy hw) t2) r) (list (+ cx tw) (- (+ cy hw) t2) r) (list (+ cx bw) (- (+ cy hw) t2) 0.0) (list (+ cx bw) (+ cy hw) 0.0) (list (- cx bw) (+ cy hw) 0.0) (list (- cx bw) (- (+ cy hw) t2) 0.0) (list (- cx tw) (- (+ cy hw) t2) r) (list (- cx tw) (+ (- cy hw) t2) r) (list (- cx bw) (+ (- cy hw) t2) 0.0))) (setq dxf (append dxf (list (cons 10 (list (car v) (cadr v))) (cons 42 (caddr v)))))) (entmake (subst (cons 90 (/ (- (length dxf) 5) 2)) '(90 . 0) dxf)) (entlast) ) (defun c:HBS (/ *error* old ce osm ss row i ent tf new n skip) (setq ce (getvar "CMDECHO") osm (getvar "OSMODE") old *error*) (defun *error* (msg) (command "_.UNDO" "_E") (setvar "OSMODE" osm) (setvar "CMDECHO" ce) (setq *error* old) (if (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*")) (princ (strcat "\nError: " msg))) (princ)) (setvar "CMDECHO" 0) (princ "\nH형강 선택: ") (if (and (setq ss (ssget '((0 . "LWPOLYLINE")))) (setq row (tv-hbeam-ask))) (progn (setvar "OSMODE" 0) (command "_.UNDO" "_BE") (setq i 0 n 0 skip 0) (repeat (sslength ss) (setq ent (ssname ss i) i (1+ i)) (cond ((/= 0 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget ent)))))))) (setq skip (1+ skip))) ((setq tf (tv-hbeam-frame ent)) (setq new (tv-hbeam-make (car tf) row)) (if (/= (cadr tf) 0.0) (command "_.ROTATE" new "" (car tf) (* (cadr tf) (/ 180.0 pi)))) (command "_.MATCHPROP" ent new "") (entdel ent) (setq n (1+ n))))) (command "_.UNDO" "_E") (princ (strcat "\n" (itoa n) " sections set to H-" (car row) (if (> skip 0) (strcat ", " (itoa skip) " on locked layers skipped") ""))) ) ) (setvar "OSMODE" osm) (setvar "CMDECHO" ce) (setq *error* old) (princ) ) (princ "\nTORVA H-Beam Section Swap: HBS | 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 ----