(prompt "\nAngle Trisection by AutoCAD - LINK_KEMPE.LSP") (prompt "\nCommands: TEST_Kempe KEMPE ANIMATION_KEMPE") (prompt "\nFunctions: (LOCATE) (LOCATE_ADD) (SETUP) (INIT_DISPLAY)") (prompt "\n (DOUBLE_LINK) (RESET) (DISPLAY_NODES) (SHOW_RESULT)") ;---------------------------------------------------------- ;link test #9 7/01/99 Takaya Iwamoto ;test the generic function called double_link() ;; added two more double link ;; fix one link to a reference line ;; (defun C:test_Kempe() ;Main routine (setup_kempe) ;set up (init_display) (alert "Place the cursor near the point \"D\", then click left mouse to start.") (setq answer (getpoint "\nPress left mouse to start.Click mouse to stop."))(terpri) (entdel new_pnt_ent) (entdel new_txt_ent) ;;;begin test ;(command "_.vports" "2" "v" ) ;(command "_.zoom" "w" lower_left upper_right) ;;;end test (while (and (setq key (grread T)) (= (car key) 5) ) (setq pnt_temp (cadr key)) (setq tmp_ang (angle pnt_b pnt_temp) pnt_tmp (polar pnt_b tmp_ang 4.0) ) (entdel last_pline) (locate pnt_tmp) (pl_display) (setq last_pline (entlast)) (show_status) ) (c:display_nodes) (show_result) (reset_sysvar) );LINK_9 ;;; ;;;KEMPE ;;;main routine ::: zoom & regen is done automatically (defun c:LINK_KEMPE() (setup_kempe) ;setup parameters ;specify the angle to be tri_sected (init_display) ;set initial position (alert "Place the cursor near the point \"D\", then click left mouse to start.") (setq answer (getpoint "\nMove the mouse and Press left mouse for automatic zooming and regen.")) (terpri) (entdel new_pnt_ent) (entdel new_txt_ent) (setq flag "GO" split_win "NO") (while (= flag "GO") (while (and (setq key (grread T)) (= (car key) 5) ) (setq pnt_temp (cadr key)) (setq tmp_ang (angle pnt_b pnt_temp) pnt_tmp (polar pnt_b tmp_ang 4.0) ) (entdel last_pline) (locate pnt_tmp) (pl_display) (setq last_pline (entlast)) (show_status) );inner while loop ;;;after the 2-nd round,work with 3 viewports. ;(if (= split_win "NO") (command "_.vports" "2" "v")) (if (= split_win "NO") (progn (command "_.vports" "3" "_L") (setvar "CVPORT" 2) (command "_.zoom" "_E") (setvar "CVPORT" 3) (command "_.zoom" "_E") (setvar "CVPORT" 4) (command "_.zoom" "_E") ) ) ;;;;convergence criteria check (if (= (converge) T) (setq flag "STOP")) ;;;;zoom and regen automatically for 2 viewports (zoom_regen pnt_refa pnt_d ) (setq split_win "YES") );outer while loop (command "_.vports" "SI" ) ;;;back to single view port (command "_.zoom" "_EXTENT") (c:display_nodes) (show_result) (reset_sysvar) );KEMPE ;;; ;;;CONVERGE ;;; ;;;check the convergence by computing distance between pnt_ref & pnt_g. (defun CONVERGE( / result) ;(setq test_length (abs (distance pnt_refa pnt_3aa))) (if (< (abs test_length) criteria) (setq result T) (setq result nil)) );CONVERGE ;;; ;;;ZOOM_REGEN ;;; (defun ZOOM_REGEN(pnt_target pnt_move) ;;;Target point (setq vscale (/ vscale 5.)) ;;;focus on the upper window ;(setvar "CVPORT" 2) (setvar "CVPORT" 3) (command "_.zoom" "ce" pnt_target vscale) (command "_.regen") ;;;Mouse control point (setq vscale (/ vscale 5.)) ;;;focus on the lower window ;(setvar "CVPORT" 3) (setvar "CVPORT" 4) (command "_.zoom" "ce" pnt_move vscale) (command "_.regen") );ZOOM_REGEN ;;; ;;;SHOW_STATUS ;;; show the deviation from the exact solution in status line (defun SHOW_STATUS( / result) (setq test_length (abs (distance pnt_refa pnt_3aa)) result (strcat "dist = " (rtos test_length 2 12)) ) (move_bar test_length meter_scale) ;(grtext -1 result) );SHOW_STATUS ;locate the point to satisfy the condition (defun LOCATE(pnt_tmp ) ;;first link (setq pnt_d pnt_tmp) (setq list_1 (double_link 4.0 8.0 pnt_a pnt_d)) (setq pnt_1a (car list_1) pnt_1b (cadr list_1)) ;;2-nd link (setq pnt_e (point_along_line pnt_1a pnt_d (/ 2.0 8.0)) list_2 (double_link 2.0 4.0 pnt_a pnt_e) pnt_2a (car list_2) ) ;;3-rd link (setq pnt_g (point_along_line pnt_2a pnt_e (/ 1.0 4.0)) list_3 (double_link 1.0 2.0 pnt_a pnt_g) pnt_3a (car list_3) ) (setq pnt_3aa (point_along_line pnt_a pnt_3a 4.0)) );LOCATE ;;;PL_DISPLAY ;;; (defun PL_DISPLAY() (command "_.pline" pnt_g pnt_2a pnt_a pnt_3aa pnt_3a pnt_g pnt_e pnt_1a pnt_a pnt_1b pnt_d pnt_e "") );PL_DISPLAY ;;;DOUBLE_LINK ;; (defun DOUBLE_LINK(el_1 el_2 pnt_zero pnt_move / output_list) (setq el (distance pnt_zero pnt_move) el_sqr (* el el) el_1_sqr (* el_1 el_1) el_2_sqr (* el_2 el_2) two_el (* 2.0 el) two_el_sqr (* 2.0 el_sqr) del_el (- el_2_sqr el_1_sqr) l_a (/ (- el_sqr del_el) two_el) l_b (/ (+ el_sqr del_el) two_el) ratio_a (/ l_a el) ratio_b (/ l_b el) val_1 (- el_1 l_a) val_2 (+ el_1 l_a) c_sqr (* val_1 val_2) ) (if (>= c_sqr 0.0) (setq el_c (sqrt c_sqr)) (setq el_c 0.0)) ;; compute the location of the kink points (setq pnt_1 (point_off_line pnt_zero pnt_move ratio_a half_pi el_c) pnt_2 (point_off_line pnt_zero pnt_move ratio_b half_pi el_c) ) (setq output_list (list pnt_1 pnt_2)) );DOUBLE_LINK ;;; ;;;SETUP ;;; (defun SETUP_kempe() (setup_sysvar) (setvar "PDMODE" 32) (setvar "PDSIZE" -2) (setq half_pi (* 0.5 pi) quart_pi (* 0.25 pi) sqrt_5 (sqrt 5.0) a (/ 4.0 sqrt_5) c (/ 8.0 sqrt_5) b (* 4.0 sqrt_5) pnt_a '(0 0) pnt_b '(8 0) pnt_c (list (- b a) c ) pnt_d (list b 0.0) pnt_size 0.35 criteria 1.e-8 ) (def_angle) (setq x_ref (car pnt_refa) y_ref (cadr pnt_refa) lower_left (list (- x_ref 1) (- y_ref 1)) upper_right (list (+ x_ref 1) (+ y_ref 1)) ) (setq vscale (getvar "viewsize"));;;GET CURRENT VIEW SIZE ;;;insert precision_meter ;block insert prec_meter.dwg (setq ins_pnt '(0. -3.) meter_scale 1.75 m_x (car ins_pnt) m_y (cadr ins_pnt) pm_factor (* 0.25 (/ 1. (log 10.))) ) (my_block_insert "prec_meter" ins_pnt meter_scale) ;display initial bar (my_block_insert "prec_bar" ins_pnt meter_scale) (setq old_bar (entlast)) ;;;prec_bar just created );SETUP ; ;;; ;;;DEF_ANGLE ;;; (defun DEF_ANGLE() (make_arc_cbe "0" 8 '(0 0) '(4 0) '(-4 0)) (setq arc_ent (entlast)) (command "_.zoom" "_EXTENT") (command "_.regen" ) (setvar "OSMODE" 512) ;; nearest mode (setq pnt_ref (getpoint '(0 0) "\nDefine an angle on the circle")) (setq pnt_refa (point_along_line pnt_a pnt_ref 1.25)) (setq pnt_refa pnt_ref) (make_pt "0" 3 pnt_refa) (make_line_1 "0" 2 pnt_refa pnt_a) (make_line_1 "0" 2 pnt_a '(8.5 0)) (setvar "OSMODE" 0) ;;reset Snap mode to zero (entdel arc_ent) ;;delete circle );DEF_ANGLE ;; ;; ;;; ;;; ;;;SHOW_RESULT ;;; (defun SHOW_RESULT() ;(c:display_nodes) (mark_angle pnt_1b pnt_a pnt_1a 0.75 "f" 0.35 2) (mark_angle pnt_2a pnt_a pnt_1a 0.75 "f" 0.35 2) (mark_angle pnt_3a pnt_a pnt_2a 0.75 "f" 0.35 2) );SHOW_RESULT ;; ;; ;;; ;;;DISPLAY_NODES ;;; (defun c:DISPLAY_NODES() (set_txstyle "arial") (regapp "my_point") (make_point "0" 0 pnt_a "A" 4 0.35) (make_point "0" 0 pnt_1b "B" 1 0.35) (make_point "0" 0 pnt_1a "C" 1 0.35) (make_point "0" 0 pnt_2a "F" 2 0.35) (make_point "0" 0 pnt_3a "H" 3 0.35) (make_point "0" 0 pnt_e "E" 2 0.35) (make_point "0" 0 pnt_g "G" 2 0.35) (make_point "0" 0 pnt_d "D" 1 0.35) );DISPLAY_NODES ; ;;; ;;;INIT_DISPLAY ;;; (defun INIT_DISPLAY() (setq init_pos '(9.52431 -3.69817 0)) (locate init_pos) (pl_display) (setq last_pline (entlast)) (regapp "my_point") (make_point "0" 0 pnt_d "D" 1 pnt_size) (command "_.zoom" "_EXTENT") (command "_.regen" ) );INIT_DISPLAY ;; ;;; ;;;ANIMATION_KEMPE ;;; (defun C:animation_kempe() ;Main routine (setup_kempe) ;set up (init_display2) ;(command "_.zoom" "_E") ;(command "_.regen") (setq end_pos '(8.42807 -3.97703) dist (distance init_pos end_pos) nstep 5 del_step (/ 1. (float nstep)) ;;5 steps animation n_cur 1 ) (make_jpg) (alert "\nNext step?") (entdel new_pnt_ent) (entdel new_txt_ent) (repeat nstep (setq pnt_temp (plt init_pos end_pos (* n_cur del_step))) (setq tmp_ang (angle pnt_b pnt_temp) pnt_tmp (polar pnt_b tmp_ang 4.0) ) (entdel last_pline) (locate pnt_tmp) (pl_display) (setq last_pline (entlast)) (show_status) (make_jpg) ;;make jpg file (alert "\nNext step?") (command "_.delay" 500) (setq n_cur (1+ n_cur)) );;;repeat loop (c:display_nodes) (make_jpg) (show_result) (make_jpg) (make_jpg) (reset_sysvar) );;;ANIMATION_KEMPE ;;; ;;;INIT_DISPLAY2 ;;; (defun INIT_DISPLAY2() ;(setq init_pos '(9.52431 -3.69817 0)) (setq init_pos '(10.5712 -3.06418 0)) ;(10.5712 -3.06418) (locate init_pos) (pl_display) (setq last_pline (entlast)) (regapp "my_point") (make_point "0" 0 pnt_d "D" 1 pnt_size) (command "_.zoom" "_EXTENT") (command "_.regen" ) );INIT_DISPLAY2 ;; ;;-------------------------------------------------------------------------- (princ)