3-POINT_4-POINT_ANGLE_v2_02.......................free

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:

Version history:
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