;;; WBOX.LSP ;;; ;;; KETIV Technologies, Inc. ;;; 6645 NE 78th Court #C-2 ;;; Portland, OR 97218 ;;; ;;; Layer Group: WBOX ;;; ;;; Menu Location: Draw1 pull down, Tablet J4 ;;; ;;; Purpose: To create a box by picking two points on the screen ;;; ;;; Prompts: Entities drawn will be POLYLINES ;;; Toggle to lines/: ;;; Other corner: ;;; ;;; Assumptions/Limitations: None ;;; ;;;====================================================================================================== ;;; Initialize memory and important system variables ;;; ;;;> Author: Henry C. Francis ;;;> 425 N. Ashe St. ;;;> Southern Pines, NC 28387 ;;;> http://paracadd.com ;;;> All rights reserved. ;;; ;;;> COPYRIGHT: 1986, 1987, 1988, 1989 by KETIV Technologies, Inc. ;;;> EDITED: 04-08-1997 ;;; (setq marker 'mark mark 1) (setq hdrlst (list (cons "limcheck" (getvar "limcheck" )) (cons "osmode" (getvar "osmode" )) ) ) (setvar "cmdecho" 0) (setvar "limcheck" 0) (setq clayer (getvar "clayer")) (setlay "wbox") ;====================================================================================================== (defun pick() (if (= (getvar "skpoly") 1) (progn (prompt "\nEntities drawn will be POLYLINES.") (setq kind " lines")) (progn (prompt "\nEntities drawn will be LINES.") (setq kind " plines")) ) (initget "T L P") (setq pt1 (getpoint (strcat "\nToggle to" kind "/: "))) ) (pick) (while pt1 (cond ((member pt1 '("T" "L" "P")) (if (= (getvar "skpoly") 1) (progn (setvar "skpoly" 0) (setq kind " line") ) (progn (setvar "skpoly" 1) (setq kind " pline") ) ) ) (t (setq pt3 (getcorner pt1"\nOther corner: ")) (setq pt2 (list (car pt3) (cadr pt1))) (setq pt4 (polar pt1 5.5 0.0625)) (setq pt5 (polar pt2 5.5 0.0625)) (setq pt6 (polar pt3 5.5 0.0625)) (setq osmode (getvar "osmode")) (setvar "osmode" 0) (command (if (= 1 (getvar "skpoly")) "pline" "line") pt1 (list (car pt1) (cadr pt3)) pt3 (list (car pt3) (cadr pt1)) "c" ) (command "solid" pt1 pt4 pt2 pt5 pt3 pt6 "") (setvar "osmode" osmode) ) ) (pick) ) (command "layer" "s" clayer "") (foreach cnt hdrlst (setvar (car cnt) (cdr cnt))) (setq atomlist (cdr (member 'mark atomlist))) (gc) (princ)