Command: 3PA
This function measures angle in dergees between 3 points in UCS View.
Command: 4PA
This function measures angle in dergees between two lines enclosed within pt1-pt2 and pt3-pt4 in UCS View.
Code:
;;; ================================================= ;;; 3PT_4PT_ANGLE_v2_02.LSP ;;; ;;; Written by Andrzej Kalinowski, www.autolisps.blogspot.com ;;; v1.00 - 04.04.2017 - first release ;;; v2.01 - 18.04.2019 - 4Pa command added ;;; v2.02 - 22.04.2024 - cmdecho=0 added ;;; ;;; Command: 3PA - measures angle in dergees between 3 points in UCS View ;;; Command: 4PA - measures angle in dergees between 2 lines enclosed within pt1-pt2 and pt3-pt4 in UCS View ;;; ================================================= (defun c:3PA () (3PA_4PA_COMMON 0) );defun (defun c:4PA () (3PA_4PA_COMMON 1) );defun (defun 3PA_4PA_COMMON (mode1 / pt1 pt2 pt3 pt4 pt5 ang1 ang2 ang3 ang4) (setq old_cmdecho (getvar "CMDECHO") ) (setvar "CMDECHO" 0) ;----------------------------------------- ;error section ;----------------------------------------- (defun *error* (msg) (princ "error: ") (princ msg) (princ) ) (defun errtrap1 (errormsg1) (setq *error* temperr) (3PA_4PA_RESTORE) (if (and errormsg1 (not (wcmatch (strcase errormsg1) "*BREAK*,*CANCEL*,*QUIT*") ) ) (prompt (strcat "Error: " errormsg1) );then );if (princ) );defun err ;----------------------------------------- ;setting variables ;----------------------------------------- (setq temperr *error* *error* errtrap1 );setq (command "_UCS" "_NA" "_D" "old_ucs1") (command "_UCS" "_NA" "_S" "old_ucs1") (command "_UCS" "_V") ;----------------------------------------- (setq pt1 (getpoint ) pt2 (getpoint pt1) );setq (grdraw pt1 pt2 3 1) ;----------------------------------------- ;action in 3PA or 4PA command ;----------------------------------------- (cond ( (= mode1 0) ;3PA command (setq pt3 (getpoint pt2) pt1 (list (car pt1) (cadr pt1) 0 ) pt2 (list (car pt2) (cadr pt2) 0 ) pt3 (list (car pt3) (cadr pt3) 0 ) ang1 (angle pt2 pt1) ang2 (angle pt2 pt3) ang3 (abs (- ang2 ang1) ) ang3 (* 180.0 (/ ang3 pi) ) ;calculates angle (from radians to degrees) of the line enclosed within pt1-pt2, ang4 (- 360 ang3) );setq (grdraw pt2 pt3 3 1) ) ( (= mode1 1) ;3PA command (setq pt3 (getpoint) pt4 (getpoint pt3) pt1 (list (car pt1) (cadr pt1) 0 ) pt2 (list (car pt2) (cadr pt2) 0 ) pt3 (list (car pt3) (cadr pt3) 0 ) pt4 (list (car pt4) (cadr pt4) 0 ) pt5 (inters pt1 pt2 pt3 pt4 nil) ang1 (angle pt5 pt1) ang2 (angle pt5 pt3) ang3 (abs (- ang2 ang1) ) ang3 (* 180.0 (/ ang3 pi) ) ;calculates angle (from radians to degrees) of the line enclosed within pt1-pt2, ang4 (- 360 ang3) );setq (if (> (distance pt5 pt1 ) (distance pt5 pt2 ) ) (grdraw pt1 pt5 3 1) (grdraw pt2 pt5 3 1) );if (if (> (distance pt5 pt3 ) (distance pt5 pt4 ) ) (grdraw pt3 pt5 3 1); 3 is a color number (grdraw pt4 pt5 3 1) );if ) );cond ;----------------------------------------- ; program ending ;----------------------------------------- (3PA_4PA_RESTORE) (command "_DELAY" 400) (redraw) (if (> ang4 ang3) (princ (strcat "\nInner angle: "(rtos ang3 2 8) "\t\tOuter angle: " (rtos ang4 2 8) " degrees" ) ) (princ (strcat "\nInner angle: "(rtos ang4 2 8) "\t\tOuter angle: " (rtos ang3 2 8) " degrees") ) );if (princ) );defun (defun 3PA_4PA_RESTORE ( / ) (if (not command-s);checks if command-s is recognised to work with older autocad versions. Prevents srror: "_cannot_invoke_from_err_solution" (progn (command "_UCS" "_NA" "_R" "old_ucs1"); restoring UCSr (command "_UCS" "_NA" "_D" "old_ucs1");deleting ucs name. "command" doesnt work within error trap. You have to use "vl-cmdf" );progn (progn (command-s "_UCS" "_NA" "_R" "old_ucs1"); restoring UCSr (command-s "_UCS" "_NA" "_D" "old_ucs1");deleting ucs name. "command" doesnt work within error trap. You have to use "vl-cmdf" );progn );if (setvar "CMDECHO" old_cmdecho) (setq old_cmdecho nil) );defun
Example:
1.00 - 04.04.2017 - first release
2.01 - 18.04.2019 - 4Pa command added
2.02 - 22.04.2024 - cmdecho=0 added
Compatibility:
all Autocad versions
Download file:
No comments:
Post a Comment