(defun c:K1 (/ dcl_id D1 D2 H S Z) (vl-load-com) ;(command "_layer" "NEU" "KONUS" "FA" "7" "KONUS" "LS" "0.15" "KONUS" "") ;(setvar "CLAYER" "KONUS") (setvar "CLAYER" "0") (setvar "orthomode" 0) (if (< (setq dcl_id (load_dialog "K1")) 0) (progn (alert "DCL - Datei nicht gefunden") (exit) ) ) (if (not (new_dialog "K1" dcl_id)) (exit) ) (setq breite (dimx_tile "bild") hoehe (dimy_tile "bild") ) (action_tile "cancel" "(done_dialog)(exit)") (action_tile "Bt" "(setq Bt (atof $Value))") (action_tile "D1" "(setq D1 (atof $Value))") (action_tile "D2" "(setq D2 (atof $Value))") (action_tile "H" "(setq H (atof $Value))") (action_tile "S" "(setq S (atof $Value))") (action_tile "Z" "(setq Z (atof $Value))") (mode_tile "Bt" 2) (set_tile "D1" "") (set_tile "D2" "") (set_tile "H" "") (set_tile "S" "") (set_tile "Z" "") (start_image "bild") (slide_image -135 10 675 235 "K1") (end_image) (start_dialog) (unload_dialog dcl_id) ---------------------------------------------------------------------------- (setq var1 (/ S 2)) (setq var2 (- D1 D2)) (setq var3 (* H 2)) (setq var4 0.017453) ---------------------------------------------------------------------------- (setq var5 (/(atan (/ var2 var3))var4));;Winkel Konus;; ---------------------------------------------------------------------------- (setq var6 (* var5 var4)) (setq var7 (* var6 var1)) (setq var8 (* var1 (cos var6))) (setq var9 (*(- var8 var1)2)) (setq var10 (- D1 S var9)) (setq var11 (- D2 S var9)) ---------------------------------------------------------------------------- (setq A1 (atan (/ H 0.5 (- D1 D2 )))) (setq R1 (/ var10 2(cos A1))) (setq R2 (-(/ var11 2(cos A1))Z)) (setq A (/ (* var10 PI) R1)) (command "_PLINE") (command (list (* (sin (/ A 2.0)) R1) (* (cos (/ A 2.0)) R1) 0.0)) (command "_a" "_s") (command (list 0.0 R1 0.0)) (command (list (* (sin (/ A 2.0)) R1 -1.0)(* (cos (/ A 2.0)) R1) 0.0)) (command "_l") (command (list (* (sin (/ A 2.0)) R2 -1.0)(* (cos (/ A 2.0)) R2) 0.0)) (command "_a" "_s") (command (list 0.0 R2 0.0)) (command (list (* (sin (/ A 2.0)) R2) (* (cos (/ A 2.0)) R2) 0.0)) (command "_l" "_c") (command "_move" (entlast)"" (list (* (sin (/ A 2.0)) R1) (* (cos (/ A 2.0)) R1) 0.0)) (princ) )