;;; ;;; Author: Henry C. Francis ;;; 425 N. Ashe St. ;;; Southern Pines, NC 28387 ;;; ;;; http://www.paracadd.com ;;; All rights reserved. ;;; ;;; Copyright: 10-29-2014 ;;; Edited: 12-20-2016 ;;; ;;;**************************************************************************** (DEFUN C:BLDGPL (/ bldgpt1 bldgpt2 bldgptn bldg_pts_lst bldg_finish_corner from_bldgpl) (SETQ old_bldgpl_snapang (GETVAR "snapang") old_bldgpl_orthomode (GETVAR "orthomode") old_bldgpl_osmode (GETVAR "osmode") ) (IF upoint NIL (LOAD "upoint" "\nFile UPOINT.LSP not loaded! ")) (SETVAR "orthomode" 0) (SETVAR "osmode" 0) (WHILE (EQ (SETQ bldgpt1 (upoint 1 "Snapangle" "First building point [Snapangle]" nil nil)) "Snapangle") (SETQ snapang1 (upoint 1 "" "Specify first point" nil nil)) (SETQ snapang2 (upoint 1 "" "Specify second point" nil snapang1)) (SETVAR "SNAPANG" (ANGLE snapang1 snapang2)) ) (SETQ bldgpt2 (upoint 1 "" "Second building point" nil bldgpt1)) (SETVAR "snapang" (ANGLE bldgpt1 bldgpt2)) (SETVAR "orthomode" 1) (SETQ bldgptn bldgpt2) (SETQ bldg_pts_lst (LIST bldgpt1 bldgpt2)) (COMMAND "pline" bldgpt1 bldgpt2) (WHILE (AND (OR (AND (EQ (TYPE bldgptn) 'STR) (WCMATCH bldgptn "Undo,Line,Arc,Return") ) (NOT (EQ (TYPE bldgptn) 'STR)) ) (SETQ bldgptn (upoint 0 (IF (AND ;(EQ (LENGTH bldg_pts_lst) 3) (>= (LENGTH bldg_pts_lst) 3) (OR (EQUAL (SIN (ANGLE (CADR (REVERSE bldg_pts_lst))(LAST bldg_pts_lst))) (SIN (+ (ANGLE (CAR bldg_pts_lst)(CADR bldg_pts_lst)) (/ PI 2.0))) 0.018 ) (EQUAL (SIN (ANGLE (CADR (REVERSE bldg_pts_lst))(LAST bldg_pts_lst))) (SIN (- (ANGLE (CAR bldg_pts_lst)(CADR bldg_pts_lst)) (/ PI 2.0))) 0.018 ) (AND (EQ (LENGTH bldg_pts_lst) 3) (NOT (EQUAL (ANGLE (CAR bldg_pts_lst)(CADR bldg_pts_lst))(ANGLE (CADR bldg_pts_lst)(LAST bldg_pts_lst))0.4)) (NOT (EQUAL (ANGLE (CAR bldg_pts_lst)(CADR bldg_pts_lst))(ANGLE (LAST bldg_pts_lst)(CADR bldg_pts_lst))0.4)) ) ) ) "Close Undo Line Arc Return Finish" "Close Undo Line Arc Return" ) (IF (AND ;(EQ (LENGTH bldg_pts_lst) 3) (>= (LENGTH bldg_pts_lst) 3) (OR (EQUAL (SIN (ANGLE (CADR (REVERSE bldg_pts_lst))(LAST bldg_pts_lst))) (SIN (+ (ANGLE (CAR bldg_pts_lst)(CADR bldg_pts_lst)) (/ PI 2.0))) 0.018 ) (EQUAL (SIN (ANGLE (CADR (REVERSE bldg_pts_lst))(LAST bldg_pts_lst))) (SIN (- (ANGLE (CAR bldg_pts_lst)(CADR bldg_pts_lst)) (/ PI 2.0))) 0.018 ) (AND (EQ (LENGTH bldg_pts_lst) 3) (NOT (EQUAL (ANGLE (CAR bldg_pts_lst)(CADR bldg_pts_lst))(ANGLE (CADR bldg_pts_lst)(LAST bldg_pts_lst))0.4)) (NOT (EQUAL (ANGLE (CAR bldg_pts_lst)(CADR bldg_pts_lst))(ANGLE (LAST bldg_pts_lst)(CADR bldg_pts_lst))0.4)) ) ) ) "Next building point or [Close/Undo/Line/Arc/Return/Finish]" "Next building point or [Close/Undo/Line/Arc/Return]" ) nil (IF (EQ (TYPE bldgptn) 'LIST) bldgptn (IF bldg_pts_lst (LAST bldg_pts_lst) NIL ) ) ) ) ) (IF (EQ (LENGTH bldg_pts_lst) 1) (IF (EQ (TYPE bldgptn) 'LIST) (COMMAND bldgptn) ) (COND ((AND (EQ bldgptn "Finish") (>= (LENGTH bldg_pts_lst) 3)) (SETQ bldgptn "Close" bldg_finish_corner (IF (AND (EQ (LENGTH bldg_pts_lst) 3) (NOT (EQUAL (ANGLE (CAR bldg_pts_lst)(CADR bldg_pts_lst))(ANGLE (CADR bldg_pts_lst)(LAST bldg_pts_lst))0.4)) (NOT (EQUAL (ANGLE (CAR bldg_pts_lst)(CADR bldg_pts_lst))(ANGLE (LAST bldg_pts_lst)(CADR bldg_pts_lst))0.4)) ) (POLAR (CAR bldg_pts_lst) (ANGLE (CADR bldg_pts_lst)(LAST bldg_pts_lst))(DISTANCE (CADR bldg_pts_lst)(LAST bldg_pts_lst))) (INTERS (CAR bldg_pts_lst) (POLAR (CAR bldg_pts_lst) (+ (ANGLE (CAR bldg_pts_lst)(CADR bldg_pts_lst)) (/ PI 2.0)) 100.0) (LAST bldg_pts_lst) (POLAR (LAST bldg_pts_lst) (ANGLE (CAR bldg_pts_lst)(CADR bldg_pts_lst)) 100.0) NIL ) ) ) (COMMAND bldg_finish_corner "Close") ) ((AND (EQ bldgptn "Return") (>= (LENGTH bldg_pts_lst) 3)) (SETQ bldg_return_point (POLAR (LAST bldg_pts_lst) (ANGLE (CADR (REVERSE bldg_pts_lst))(CADDR (REVERSE bldg_pts_lst))) (DISTANCE (CADR (REVERSE bldg_pts_lst))(CADDR (REVERSE bldg_pts_lst))) ) ) (SETQ bldgptn bldg_return_point) (COMMAND bldgptn) ) (T (COMMAND bldgptn)) ) ) (COND ((EQ (TYPE bldgptn) 'LIST) (SETQ bldg_pts_lst (APPEND bldg_pts_lst (LIST bldgptn)))) ((AND (EQ bldgptn "Undo")(> (LENGTH bldg_pts_lst) 1)) (SETQ bldg_pts_lst (REVERSE (CDR (REVERSE bldg_pts_lst))))) ) ) (SETQ from_bldgpl T) (SETVAR "snapang" old_bldgpl_snapang) (SETVAR "orthomode" old_bldgpl_orthomode) (SETVAR "osmode" old_bldgpl_osmode) (c:setbldg) (SETQ from_bldgpl NIL) (PRINC) ) ;;;**************************************************************************** (DEFUN C:BLDG () (C:BLDGPL)) ;;;****************************************************************************