Category : Printer + Display Graphics
Archive   : WALLS.ZIP
Filename : WALLS.LSP

 
Output of file : WALLS.LSP contained in archive : WALLS.ZIP
; Walls Version 1.2
; Copyright 1987 Alacrity
;
; WALL1 and WALL2 - AutoCAD Ver 2.5x and up
; NEAT - AutoCAD 2.6x and up
; OPENING, DOOR, WINDOW and RELITE - AutoCAD 2.5x and up
;
; Jason Osgood
; 12405 SE 25 th
; Bellevue, Wa. 98005
;
; CompuServe ID: 73417,1756

; Read Walls.DOC for the whos, whats, wheres, hows and whys.

; elminates screen garbage when an AutoLISP error happens
(defun *error* (msg)
(princ "\nerror: ")
(princ msg)
(terpri)
(restore)
)

; saves enviroment
(defun store ()

(setvar "UserI1" (getvar "OsMode"))
(setvar "UserI2" (getvar "OrthoMode"))
(setvar "UserI3" (getvar "Aperture"))
(setvar "UserI4" (getvar "Pickbox"))
(setvar "UserI5" (getvar "BlipMode"))
)

(defun argh () (princ "Invalid input..."))

; restores enviroment
(defun restore ()
(setvar "CmdEcho" 1)
(setvar "OsMode" (getvar "UserI1"))
(setvar "OrthoMode" (getvar "UserI2"))
(setvar "Aperture" (getvar "UserI3"))
(setvar "Pickbox" (getvar "UserI4"))
(setvar "BlipMode" (getvar "UserI5"))
)

; Wall1 - draws line(s) offset from user line (with corners FILLETed)
(defun c:WALL1 (/ pt1 pt2 ss ang rl)
(store)
(setvar "CmdEcho" 0)
(setvar "FilletRad" 0)
(setq temp nil)
(while (not temp)
(setq temp (getdist (strcat "\nOffset distance"
(if d (strcat " <" (rtos d (getvar "lunits")
(getvar "luprec")) ">") "") ": ")))
(cond
((> temp 0) (setq d temp))
((and (not temp) d) (setq temp T))
(T (progn
(setq temp nil)
(princ "Value must be positive and nonzero")
)
)
)
)
(while (not (setq pt1 (getpoint "\nFrom point: "))) (argh))
(while (not (setq pt2 (getpoint pt1 "\nTo point: "))) (argh))
(command "LINE" pt1 pt2 "")
(while (not (setq rl (getpoint "\nWhich side? "))) (argh))
(setq rl (- (angle pt1 rl) (setq ang (angle pt1 pt2))))
(if (< rl 0) (setq rl (+ rl pi pi)))
(if (< rl pi) (setq rl +) (setq rl -))
(command "COPY" "L" "" pt1 (polar pt1 (rl ang 1.570796) d))
(setq ss (ssadd (entlast)))
(setq pt1 pt2)
(while (setq pt2 (getpoint pt1 "To point: "))
(command "LINE" pt1 pt2 "")
(setq ang (angle pt1 pt2))
(command "COPY" "L" "" pt1 (polar pt1 (rl ang 1.570796) d))
(setq ss (ssadd (entlast) ss))
(command "FILLET" ss)
(ssdel (ssname ss 0) ss)
(setq pt1 pt2)
)
(restore)
(command)
)


;Wall2
(defun c:WALL2 (/ pt1 pt2 ss1 ss2 ang)
(store)
(setvar "CmdEcho" 0)
(setvar "FilletRad" 0)
(setq temp nil)
(while (not temp)
(setq temp (getdist (strcat "\nOffset distance"
(if d (strcat " <" (rtos d (getvar "lunits")
(getvar "luprec")) ">") "") ": ")))
(cond
((> temp 0) (setq d temp))
((and (not temp) d) (setq temp T))
(T (progn
(setq temp nil)
(princ "Value must be positive and nonzero")
)
)
)
)
(while (not (setq pt1 (getpoint "\nFrom point: "))) (argh))
(while (not (setq pt2 (getpoint pt1 "\nTo point: "))) (argh))
(command "LINE" pt1 pt2 "")
(setq ang (angle pt1 pt2))
(command "MOVE" "L" "" pt1 (polar pt1 (- ang 1.570796) (/ d 2)))
(setq ss1 (ssadd (entlast)))
(command "COPY" "L" "" pt1 (polar pt1 (+ ang 1.570796) d))
(setq ss2 (ssadd (entlast)))
(setq pt1 pt2)
(while (setq pt2 (getpoint pt1 "To point: "))
(command "LINE" pt1 pt2 "")
(setq ang (angle pt1 pt2))
(command "MOVE" "L" "" pt1 (polar pt1 (- ang 1.570796) (/ d 2)))
(setq ss1 (ssadd (entlast) ss1))
(command "COPY" "L" "" pt1 (polar pt1 (+ ang 1.570796) d))
(setq ss2 (ssadd (entlast) ss2))
(command "FILLET" ss1)
(command "FILLET" ss2)
(ssdel (ssname ss1 0) ss1)
(ssdel (ssname ss2 0) ss2)
(setq pt1 pt2)
)
(restore)
(command)
)

;Neat - cleans up wall (parallel line) intersections
(defun c:NEAT (/ pt1 pt2 lst linint intlst i j num ss)
(store)
(setvar "CmdEcho" 0)
(setvar "OsMode" 0)
(setvar "SnapMode" 0)
(setvar "PickBox" 1)
(setvar "FilletRad" 0)
(while (not (setq pt1 (getpoint "\nFirst corner: "))) (argh))
(while (not (setq pt2 (getcorner pt1 "\nOther corner: ")))
(argh)
)
(setq ss (ssget "C" pt1 pt2))
(setq num (sslength ss) i 0)
(while (< i num)
(setq ent (entget (ssname ss i)))
(if (= (cdr (assoc 0 ent)) "LINE")
(progn
(setq lst (cons (list (cdr (assoc 10 ent))
(cdr (assoc 11 ent))) lst))
(setq i (1+ i))
)
(progn
(ssdel (ssname ss i) ss)
(setq num (1- num))
)
)
)
(setq i 0)
(while (< i num)
(setq j 0 intlst nil)
(while (< j num)
(if (setq int (inters (car (nth i lst)) (cadr (nth i lst))
(car (nth j lst)) (cadr (nth j lst)) T))
(setq intlst (cons int intlst))
)
(setq j (1+ j))
)
(setq linint (cons intlst linint) i (1+ i))
)
(setq i 0 lst nil)
(while (< i num)
(if (> (length (setq intlst (nth i linint))) 1)
(progn
(setq pt1 (car intlst) pt2 (cadr intlst))
(command "BREAK" (polar pt1 (angle pt1 pt2)
(/ (distance pt1 pt2) 2)) "F" pt1 pt2)
)
(setq lst (cons (car intlst) lst))
)
(setq i (1+ i))
)
(setq num (length lst) i 0)
(while (< i num)
(command "FILLET" (nth i lst) "@")
(setq i (1+ i))
)
(restore)
(command)
)

; Special Thanks to Mike Barnes and Rebecca O'Rourke for help doing the
; following routines.

;Opening - generates opening in wall (i.e. parallel lines).
(defun c:OPENING ()
(store)
(setvar "CmdEcho" 0)
(brkwall "opening" "Insertion")
(restore)
(command)
)

;Door - generates door in wall.
(defun c:DOOR ()
(store)
(setvar "CmdEcho" 0)
(if (not ang2) (setq ang2 1.570796))
(brkwall "door" "Hinge" nil nil)
(setq temp nil)
(while (not temp)
(setq temp (getangle (strcat "\nAngle of door <"
(angtos ang2 (getvar "aunits") (getvar "auprec")) ">: ")))
(cond
((and (> temp 0) (< temp pi)) (setq ang2 temp))
((not temp) (setq temp T))
(T (progn
(setq temp nil)
(princ "Angle must be between 0 and 180 degrees.")
)
)
)
)
(setq p5 (polar p1 (rl ang 1.570796 ang2) width))
(command "LINE" p1 p5 "")
(command "ARC" "C" p1 p3 "A" (rl (* ang2 57.295780)))
(restore)
(command)
)

;Window - generates 'exterior' window in wall.
(defun c:WINDOW ()
(store)
(setvar "CmdEcho" 0)
(brkwall "window" "Inside" T nil)
(setq dist (/ (distance p1 p2) 2))
(command "LINE" (polar p1 ang dist) (polar p3 ang dist) "")
(setq temp nil)
(while (not temp)
(setq temp (getdist p2 (strcat "\nWidth of ledge"
(if ledge (strcat " <" (rtos ledge (getvar "lunits")
(getvar "luprec")) ">") "") ": ")))
(cond
((> temp 0) (setq ledge temp))
((and (not temp) ledge) (setq temp T))
(T (progn
(setq temp nil)
(princ "Value must be positive and nonzero")
)
)
)
)
(command "PLINE" p2 (polar p2 ang ledge) (polar p4 ang ledge) p4 "")
(restore)
(command)
)

;RELITE - generates 'interior' window in wall.
(defun c:RELITE ()
(store)
(setvar "CmdEcho" 0)
(if (equal (setq a (getstring "\nRemove wall? No/:")) "")
(setq a nil)
)
(brkwall "window" "Insertion" a a)
(setq dist (/ (distance p1 p2) 2))
(command "LINE" (polar p1 ang dist) (polar p3 ang dist) "")
(restore)
(command)
)

;used by OPENING, DOOR and WINDOW
(defun brkwall (msg1 msg2 a b)
(setvar "BlipMode" 1)
(setvar "OsMode" 512)
(while (not (setq p1 (getpoint (strcat "\n" msg2 " point on wall: "))))
(argh)
)
(setvar "OsMode" 128)
(while (not (setq p2 (getpoint p1 "\nTouch opposite side of wall: ")))
(argh)
)
(setvar "BlipMode" 0)
(setvar "OsMode" 0)
(setq temp nil)
(while (not temp)
(setq temp (getdist p1 (strcat "\nWidth of " msg1
(if width (strcat " <" (rtos width (getvar "lunits")
(getvar "luprec")) ">") "") ": ")))
(cond
((> temp 0) (setq width temp))
((and (not temp) width) (setq temp T))
(T (progn
(setq temp nil)
(princ "Value must be positive and nonzero")
)
)
)
)
(while (not (setq rl (getpoint "\nWhich side? ")))
(argh)
)
(setq rl (- (angle p1 rl) (setq ang (angle p1 p2))))
(if (< rl 0) (setq rl (+ rl pi pi)))
(if (< rl pi) (setq rl +) (setq rl -))
(setq p3 (polar p1 (rl ang 1.570796) width))
(setq p4 (polar p2 (rl ang 1.570796) width))
(if a (command "BREAK" p1 p1 "BREAK" p3 p3) (command "BREAK" p1 p3))
(if b (command "BREAK" p2 p2 "BREAK" p4 p4) (command "BREAK" p2 p4))
(command "LINE" p1 p2 "")
(command "LINE" p3 p4 "")
)


  3 Responses to “Category : Printer + Display Graphics
Archive   : WALLS.ZIP
Filename : WALLS.LSP

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/