;;;Converts a (LW)Polyline through any 3 points into a closed 4 point polyline that describes a parallelogram ;;;with corners at the original 3 points (4th point is mathematically constructed). ;;; ;;;Purpose: To "finish the box" described by 3 surveyed points on a 4 cornered object, e.g. equipment pads, etc. ;;; Typically used to create an approximate square or rectangle from 3 survey points. It will always ;;; create a parallelogram. ;;; ;;; Author: Henry C. Francis ;;; 425 N. Ashe St. ;;; Southern Pines, NC 28387 ;;; http://paracadd.com ;;; All rights reserved. ;;; ;;; COPYRIGHT: 4/15/2010 ;;; EDITED: 4/15/2010 ;;; (DEFUN C:PL2BOX () (SETQ this_l (ENTSEL "\nSelect 3-point polyline for conversion to a closed 4-point polyline (parallelogram). ")) (IF this_l (PROGN (SETQ this_selent (ENTGET (CAR this_l))) (SETQ new_selent this_selent) (SETQ this_vertex_lst NIL) (IF (EQ (CDR (ASSOC 0 this_selent)) "POLYLINE") (SETQ this_vertent (ENTGET (ENTNEXT (CDR (ASSOC -1 this_selent))))) (SETQ this_vertent NIL) ) ;_ end of IF (SETQ vertex_cnt 0) (IF (AND (OR (EQ (CDR (ASSOC 0 this_selent)) "LWPOLYLINE") (EQ (CDR (ASSOC 0 this_selent)) "POLYLINE")) (IF (EQ (CDR (ASSOC 0 this_selent)) "LWPOLYLINE") (MAPCAR '(LAMBDA (x) (IF (EQ (CAR x) 10) (PROGN (SETQ vertex_cnt (1+ vertex_cnt)) (SETQ this_vertex_lst (APPEND this_vertex_lst (LIST (CDR x)))) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of LAMBDA this_selent ) ;_ end of MAPCAR (IF (WHILE (NOT (EQ (CDR (ASSOC 0 this_selent)) "SEQEND")) (IF (EQ (CDR (ASSOC 0 this_selent)) "VERTEX") (SETQ this_ent_lst (APPEND this_ent_lst (LIST this_selent)) this_vertex_lst (APPEND this_vertex_lst (LIST (CDR (ASSOC 10 this_selent)))) vertex_cnt (1+ vertex_cnt) ) ;_ end of SETQ ) ;_ end of IF (SETQ this_selent (ENTGET (ENTNEXT (CDR (ASSOC -1 this_selent))))) ) ;_ end of WHILE T T ) ;_ end of IF ) ;_ end of IF (EQ vertex_cnt 3) ) ;_ end of AND (PROGN (IF (EQ (CDR (ASSOC 0 new_selent)) "POLYLINE") (PROGN (SETQ this_header (LIST (CONS 0 "POLYLINE") (ASSOC 8 new_selent))) (IF (ASSOC 6 new_selent) (SETQ this_header (APPEND this_header (LIST (ASSOC 6 new_selent)))) ) ;_ end of IF (SETQ this_header (APPEND this_header (LIST (ASSOC 8 new_selent)))) (IF (ASSOC 39 new_selent) (SETQ this_header (APPEND this_header (LIST (ASSOC 39 new_selent)))) ) ;_ end of IF (IF (ASSOC 48 new_selent) (SETQ this_header (APPEND this_header (LIST (ASSOC 48 new_selent)))) ) ;_ end of IF (IF (ASSOC 60 new_selent) (SETQ this_header (APPEND this_header (LIST (ASSOC 60 new_selent)))) ) ;_ end of IF (IF (ASSOC 62 new_selent) (SETQ this_header (APPEND this_header (LIST (ASSOC 62 new_selent)))) ) ;_ end of IF (IF (ASSOC 67 new_selent) (SETQ this_header (APPEND this_header (LIST (ASSOC 67 new_selent)))) ) ;_ end of IF (IF (EQ (BOOLE 1 (CDR (ASSOC 70 new_selent)) 1) 1) (SETQ this_header (APPEND this_header (LIST (ASSOC 70 new_selent)))) (SETQ this_header (APPEND this_header (LIST (CONS 70 (1+ (CDR (ASSOC 70 new_selent))))))) ) ;_ end of IF (IF (ASSOC 40 new_selent) (SETQ this_header (APPEND this_header (LIST (ASSOC 40 new_selent)))) ) ;_ end of IF (IF (ASSOC 41 new_selent) (SETQ this_header (APPEND this_header (LIST (ASSOC 41 new_selent)))) ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF (SETQ pl2box_osmode (GETVAR "OSMODE")) (SETVAR "OSMODE" 0) (SETQ vertex_1 (CAR this_vertex_lst)) (COND ((> (DISTANCE (CAR this_vertex_lst) (CADR this_vertex_lst)) (DISTANCE (CAR this_vertex_lst) (CADDR this_vertex_lst)) ) ;_ end of > (SETQ vertex_2 (CADDR this_vertex_lst) vertex_3 (CADR this_vertex_lst) ) ;_ end of SETQ ) ((> (DISTANCE (CAR this_vertex_lst) (CADDR this_vertex_lst)) (DISTANCE (CAR this_vertex_lst) (CADR this_vertex_lst)) ) ;_ end of > (SETQ vertex_2 (CADR this_vertex_lst) vertex_3 (CADDR this_vertex_lst) ) ;_ end of SETQ ) ) ;_ end of COND (SETQ vertex_m (POLAR vertex_1 (ANGLE vertex_1 vertex_3) (/ (DISTANCE vertex_1 vertex_3) 2.0)) vertex_4 (POLAR vertex_2 (ANGLE vertex_2 vertex_m) (* (DISTANCE vertex_2 vertex_m) 2.0)) ) ;_ end of SETQ (IF (EQ (CDR (ASSOC 0 new_selent)) "POLYLINE") (IF (PROGN (SETQ vertex_entlst (LIST (CONS 0 "VERTEX") (ASSOC 8 this_vertent) (ASSOC 10 this_vertent) (ASSOC 70 this_vertent) ) ;_ end of LIST ) ;_ end of SETQ (IF (ASSOC 40 this_vertent) (SETQ vertex_entlst (APPEND vertex_entlst (LIST (ASSOC 40 this_vertent)))) ) ;_ end of IF (IF (ASSOC 41 this_vertent) (SETQ vertex_entlst (APPEND vertex_entlst (LIST (ASSOC 41 this_vertent)))) ) ;_ end of IF (SETQ vertices_lst NIL) (FOREACH n (LIST vertex_1 vertex_2 vertex_3 vertex_4) (SETQ vertices_lst (APPEND vertices_lst (LIST (SUBST (CONS 10 n) (ASSOC 10 vertex_entlst) vertex_entlst))) ) ;_ end of SETQ ) ;_ end of FOREACH (ENTMAKE this_header) (FOREACH n vertices_lst (ENTMAKE n)) (ENTMAKE (LIST (CONS 0 "SEQEND"))) ) ;_ end of PROGN (ENTDEL (CDR (ASSOC -1 new_selent))) ) ;_ end of IF (PROGN (SETQ new_lwpline NIL) (FOREACH n new_selent (IF (MEMBER (CAR n) '(10 40 41 42)) (COND ((EQ (CAR n) 40) (SETQ lwpline_40 n)) ((EQ (CAR n) 41) (SETQ lwpline_41 n)) ((EQ (CAR n) 42) (SETQ lwpline_42 n)) ) (SETQ new_lwpline (APPEND new_lwpline (LIST n))) ) ) (FOREACH n (LIST vertex_1 vertex_2 vertex_3 vertex_4) (SETQ new_lwpline (APPEND new_lwpline (LIST (CONS 10 n) lwpline_40 lwpline_41 lwpline_42))) ) (SETQ new_lwpline (SUBST (CONS 90 4)(ASSOC 90 new_lwpline) new_lwpline)) (IF (EQ (BOOLE 1 (CDR (ASSOC 70 new_lwpline)) 1) 1) NIL (SETQ new_lwpline (SUBST (CONS 70 (1+ (CDR (ASSOC 70 new_lwpline))))(ASSOC 70 new_lwpline) new_lwpline)) ) ;_ end of IF (ENTMOD new_lwpline) ) ) ;_ end of IF (SETVAR "OSMODE" pl2box_osmode) ) ;_ end of PROGN ) ;_ end of IF ) ) (PRINC) ) ;_ end of DEFUN ;|«Visual LISP© Format Options» (120 2 15 2 T "end of " 100 9 2 0 nil nil nil T T) ;*** DO NOT add text below the comment! ***|;