home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 191.img / AA1.ZIP / ACAD / ACAD.LSP < prev    next >
Text File  |  1989-12-09  |  19KB  |  298 lines
  1. ; ACAD - Automatic load lisp functions
  2. ;     By Jonathan Solomon & Paul DesSureault 3/18/89 r10.0
  3. ;     (C)1989 Cadcraft,  Inc.
  4. (vmon)
  5. (grtext -1 "    (c)1989  Auto-Architect R10.3 ")
  6. ;************ LAYER VARIABLES ********************************* Autoarch
  7. (setq wallv "wall" wallmv "wallm" wallcentv "wallcl" heavyv "heavy" medv "med" 
  8.      dashedv "dashed" hiddenv "hidden" phantomv "phantom" centerv "center" 
  9.      dotv "dot" dividev "divide" doorv "door" windv "window" dimlayv "dim"
  10.      stairv "stair" columnv "column" doornov "doorno" windnov "windno"
  11.      roomnov "roomno" caseworkv "case" furnv "furn" fixtv "fixt"
  12.      colgridv "col-grid" ceilv "ceiling" symbolv "symbols" spacev "space" 
  13.      fndv "fnd" sitev "site" streetv "street" textv "text" elecv "elec" 
  14.      fnddv "footing" insulv "insul")
  15. ;************************************************************** HVAC
  16. (setq hdifv "hdiffusr" hdtagv "hdifftag" hdetv "hdetail" hductv "hduct"
  17.      hdfitv "hductfit" hflngv "hflange" hpfitv "hpipefit" hpipev "hpiping"
  18.      haeqpv "haequip" hweqpv "hwequip" hotwsv "hotws" hotwrv "hotwr"
  19.      hcowsv "hcoldws" hcowrv "hcoldwr" hctrlv "hcontrol" hpneuv "hpneum"
  20.      helecv "helec" hmiscv "hmisc" hexisv "hexist") 
  21. ;************************************************************** PLUMB
  22. (setq psanv "psan" psanwv "psanw" psanvv "psanv" pfirev "pfire" pfpipev "pfpipe"
  23.      pfsprv "pfsprink" pgasv "pgas" pfosv "pfos" pforv "pfor" pfovv "pfov"
  24.      pwaterv "pwater" pcoldwv "pcoldw" photwv "photw" photwrv "photwr"
  25.      pfixtv "pfixt" pfitv "pfit" psitev "psite" pmiscv "pmisc" ptextv "ptext"
  26.      pctrlv "pcontrols")
  27. ;************************************************************** ELEC
  28. (setq efire "efire" emisc "emisc" exit "exit" edevice "edevice"
  29.      efixt "efixt" eschema "eschema" wirelay "ewire" eexist "eexist")
  30. (setq spkv "spk" spkcv "spkc" spkpv "spkp" spkev "spkf" spktv "spkt")
  31. ;**************************************************************
  32. (if (equal (getvar "userr5") 0 0.0001)(progn (setq scale (if metric (* (getvar "ltscale") 40.)(getvar "ltscale")))(setvar "userr5" scale))(setq scale (getvar "userr5")))
  33. (setq scale1 (if metric (/ scale 50.)(/ scale 96)))(if (not (member (getvar "userr4") '(1.0 40.0 100.0 1000.0)))(progn (setq scaleb 1)(setvar "userr4" scaleb))(setq scaleb (getvar "userr4")))
  34. (setq scale1 (* scaleb (/ scale (if metric 50. 96.))))(if (not (equal (getvar "userr4") 40 0.001))(setq scale (* scaleb scale)))
  35. (if metric (progn (setq pscale (* scaleb (/ 1000.0 scale)) dscale scale)(if (equal scaleb 40 0.01)(setq scalem 1)(setq scalem (* 0.025 scaleb))))(setq scalem 1))
  36. (setq usecnt 1.0 halfpi (/ pi 2.))(setq spaces "                                                                           ")
  37. (defun *error* (st)
  38.      (princ (strcat "error: " st))
  39.      (setq lgroup nil bgroup nil pick nil ent1 nil ent nil set1 nil set2 nil)
  40.      (setq set3 nil set4 nil set5 nil alist nil blist nil clist nil group nil)
  41.      (setq dlist nil elist nil)(gc)(post)(princ)
  42. )
  43. (defun c:3f()(menucmd "s=x")(menucmd "s=3dface")(command "3dface")(princ))
  44. (defun c:a()(menucmd "s=x")(menucmd "s=arc")(command "arc")(princ))
  45. (defun c:ar()(command "array" "auto")(princ))
  46. (defun c:b()(command "block")(princ))
  47. (defun c:bk()(menucmd "s=x")(menucmd "s=break")(princ "\nSelect object to break: ")(command "break" pause "f")(princ))
  48. (defun c:bi()(setq pt1 nil pt2 nil ent (car (entsel "\nSelect object to break: ")))(while (null pt1)(initget "F R I M RR MR IR P CAL")(setq pt1 (getpoint "\nFirst break point: "))
  49.   (cond ((member pt1 '("F" "R" "I" "M" "RR" "MR" "IR"))(setq pt1 (in-line pt1 "")))((member pt1 '("P" "CAL"))(princ (strcat "\nCan NOT use " pt1 " now ! "))(setq pt1 nil))))
  50.   (initget "F R I M RR MR IR P CAL")(setq pt2 (getpoint pt1 "\nSecond break point: "))(cond ((member pt2 '("F" "R" "I" "M" "RR" "MR" "IR"))(setq pt2 (in-line pt2 "")))
  51.   ((member pt2 '("P" "CAL"))(setq pt2 (in-line pt2 pt1))))(command "break" ent pt1 pt2)(princ))
  52. (defun c:bx()(nl "" "/cci/box"))
  53. (defun c:c()(post)(menucmd "s=x")(menucmd "s=copy")(command "copy" "auto")(princ))
  54. (defun c:cb()(setq ck nil)(while (null ck)(setq ck (car (entsel "Pick existing block: "))))(setq cbname (cdr (assoc 2 (entget ck))))(command "insert" cbname))
  55. (defun c:ci()(menucmd "s=x")(menucmd "s=circle")(command "circle")(princ))
  56. (defun c:ch()(post)(command "change" "auto")(princ))
  57. (defun c:cm()(princ "\nSelect objects to copy: ")(command "select" "auto" pause)
  58.  (command "copy" "p" "" "m")(princ))
  59. (defun c:cl()(princ "\nSelect objects to copy continuously: ")(command "select" "auto" pause)(setq bgroup (ssget "p"))
  60.  (initget 1)(setq ang (getangle "\Angle for copy: "))(initget 1)(setq dist (getdist "\Distance to copy: "))(setq temp (strcat "@" (rtos dist 2 6) "<" (angtos ang 0 4)))
  61.  (while (/= temp "E")(setq ent (entlast))(command "copy" bgroup "" "0,0" temp)(initget "E")(setq temp (getdist (strcat "\nDistance to Copy/Exit <"(rtos dist)">: ")))
  62.  (if (and temp (/= temp "E"))(setq dist temp))(if (/= temp "E")(progn (setq temp (strcat "@" (rtos dist 2 6) "<" (angtos ang 0 4)) bgroup (ssadd))
  63.  (while (setq ent (entnext ent))(if ent (setq bgroup (ssadd ent bgroup)))))))(setq bgroup nil temp nil ang nil dist nil ent nil)(princ)
  64. )
  65. (defun c:d()(menucmd "s=x")(menucmd "s=dist")(command "dist")(princ))
  66. (defun c:di()(menucmd "s=x")(menucmd "s=divide")(command "divide")(princ))
  67. (defun c:dt()(command "dtext")(princ))
  68. (defun c:dv()(command "dview" "auto")(princ))
  69. (defun c:e()(post)(command "erase" "auto")(princ))
  70. (defun c:el()(command "erase" "l" "")(princ))
  71. (defun c:ed()(if (null edfile)(setq edfile "acad"))(setq temp (strcase (getstring (strcat "\nFile to edit <" edfile ">: ")) t))
  72.  (if (/= temp "")(setq edfile temp))(command "ws" edfile)(princ))
  73. (defun c:end()(pre)(post)(command ".end")(princ))
  74. (defun c:ex()(command "extend")(princ))
  75. (defun c:exp()(command "explode")(princ))
  76. (defun c:f()(menucmd "s=x")(menucmd "s=fillet")(command "fillet")(princ))
  77. (defun c:f0()(command "fillet" "r" "0")(command "fillet")(princ))
  78. (defun c:i()(command "insert")(princ))
  79. (defun c:l()(post)(menucmd "s=x")(menucmd "s=line")(command "line")(princ))
  80. (defun c:li()(command "list" "auto")(princ))
  81. (defun c:lsp()(if (null edfile)(setq edfile "acad"))(setq temp (strcase (getstring (strcat "\nFile to load <" edfile ">: ")) t))
  82.  (if (/= temp "")(setq edfile temp))(eval (read (strcat "(load " (chr 34) edfile (chr 34) ")"))))
  83. (defun c:la()(post)(menucmd "s=x")(menucmd "s=layer")(command "layer")(princ))
  84. (defun c:m()(post)(menucmd "s=x")(menucmd "s=move")(command "move" "auto")(princ))
  85. (defun c:mi()(menucmd "s=x")(menucmd "s=mirror")(command "mirror" "auto")(princ))
  86. (defun c:mo()(nl "" "/cci/moveobj")(princ))
  87. (defun c:o()(command "oops")(princ))
  88. (defun c:of()(command "offset")(princ))
  89. (defun c:p()(command "pan")(princ))
  90. (defun c:pl()(menucmd "s=x")(menucmd "s=pline")(command "pline")(princ))
  91. (defun c:po()(nl "" "/cci/layeroff"))
  92. (defun c:pe()(menucmd "s=x")(menucmd "s=p0")(command "pedit")(princ))
  93. (defun c:r()(post)(command "redraw")(princ))
  94. (defun c:ra()(command "redrawall")(princ))
  95. (defun c:re()(command "regenall")(princ))
  96. (defun c:ro()(command)(command "rotate" "auto")(princ))
  97. (defun c:s()(setq temp (getdist (strcat "\nSnap distance <" (rtos(car(getvar "snapunit"))) ">: ")))(command "snap" temp)(princ))
  98. (defun c:save()(pre)(post)(command ".save")(princ))
  99. (defun c:sc()(command "scale" "auto")(princ))
  100. (defun c:st()(menucmd "s=x")(menucmd "s=stretch")(command "stretch" "c")(princ))
  101. (defun c:str()(setq temp (getpoint "\nDraw normal Stretch box first corner: "))(setq temp1 (getcorner temp "\nOther corner: "))
  102.  (setq bgroup (ssget "c" temp temp1))(princ "\nObjects to be Stretched: ")
  103.  (command "select" bgroup "auto" "r" pause)(command "stretch" "c" temp temp1 "r" "p" "")(princ))
  104. (defun c:t()(command "text")(princ))
  105. (defun c:tm()(command "trim" "auto")(princ))
  106. (defun c:um()(post)(command "undo" "mark")(princ))
  107. (defun c:uv()(command "ucs" "v")(princ))
  108. (defun c:v()(command "view")(princ))
  109. (defun c:va()(command "view" "r" "all")(princ))
  110. (defun c:vt()(command "vpoint")(menucmd "s=x")(menucmd "s=vpoint")(princ))
  111. (defun c:vp()(command "vports")(menucmd "s=x")(menucmd "s=vports")(princ))
  112. (defun c:w()(setq temp (strcase (getvar "DWGNAME")))(setq temp1 (strcase (getstring (strcat "\nWBLOCK File name <"temp">: "))))
  113. (if (/= temp1 "")(setq temp temp1))(command "wblock" temp)(princ))
  114. (defun c:z()(post)(command "zoom")(princ))
  115. (defun c:za()(command "view" "r" "all")(princ))
  116. (defun c:zd()(command "zoom" "d")(princ))
  117. (defun c:zw()(command "zoom" "w")(princ))
  118. (defun c:zp()(command "zoom" "p")(princ))
  119. (defun pre ()
  120.  (if (or (= (getvar "useri5") 0)(null oregen))(progn
  121.   (grtext -2 "Auto-Architect")(setvar "cmdecho" 0)
  122.   (setq oregen (getvar "regenmode"))(setvar "regenmode" 0)(setq oaper (getvar "aperture"))(setvar "aperture" 3)
  123.   (setq opick (getvar "pickbox"))(setvar "pickbox" 2)(setq oexp (getvar "expert"))(setvar "expert" 1)
  124.   (setq ohigh (getvar "highlight"))(setvar "highlight" 0)(setq oblip (getvar "blipmode"))(setvar "blipmode" 0)
  125.   (setq osmode (getvar "osmode"))(setvar "osmode" 0)(setq oortho (getvar "orthomode"))(setq olayer (getvar "clayer"))
  126.   (setq oelev (getvar "elevation"))(setq othick (getvar "thickness"))(setvar "thickness" 0)
  127.   (menucmd "p1=lisptool")(setvar "useri5" 1)(setq ocoord (getvar "coords"))(princ)))
  128. )
  129. (defun post ()
  130.  (if (/= (getvar "useri5") 0)(progn
  131.   (setvar "aperture" oaper)(setvar "regenmode" oregen)(setvar "pickbox" opick)(setvar "expert" oexp)(setvar "highlight" ohigh)
  132.   (setvar "blipmode" oblip)(setvar "osmode" osmode)(setvar "orthomode" oortho)(command "layer" "s" olayer "")
  133.   (setvar "elevation" oelev)(setvar "thickness" othick)(grtext -2 (substr spaces 1 25))(setvar "coords" ocoord)
  134.   (menucmd "p1=pop1")(setvar "menuecho" 1)(setvar "useri5" 0)(princ)(savechk)
  135.  ))
  136. )
  137. (defun savechk ()
  138.    (setq usecnt (1+ usecnt))
  139.    (if (> usecnt 25)(progn  (textscr)(princ (chr 7))
  140.        (setq temp (strcase (getstring "\nFriendly reminder, Save drawing <Y>: ")))
  141.        (if (or (= temp "")(= temp "Y"))(progn (setq usecnt 0)(command ".save")(terpri))
  142.            (setq usecnt 12)) (graphscr) ))(princ)
  143. )
  144. (defun dtr (deg)(* pi (/ deg 180.0)))
  145. (defun rtd (rad)(* 180 (/ rad pi)))
  146. (defun interfnd (temp1 temp2 llist)
  147.      (setq start1 (cdr (assoc 10 llist)) end1 (cdr (assoc 11 llist)))
  148.      (setq interpt (inters temp1 temp2 start1 end1 nil))
  149.      (inters temp1 temp2 start1 end1)
  150. )
  151. (defun layside()
  152.      (menucmd "s=x")(grtext 0 "*LAYERS*")(grtext 1 " ")
  153.      (if (= x "R")(progn (grtext 0 "*VIEWS*")(grtext 1 " ")))
  154.      (if (= x "L")(progn (grtext 0 "*LTYPE*")(grtext 1 " ")))
  155.      (if (= x "B")(progn (grtext 0 "*INSERT*")(grtext 1 " ")))
  156.      (if (= x "ST")(progn (grtext 0 "*STYLE*")(grtext 1 " ")))
  157.      (if (member x '("LIST" "LLIST" "LISTS"))(progn (grtext 0 "*PICK*")(grtext 1 " ")))
  158.      (while (and (< n 17) (< (+ lshift n) (length lalist)))
  159.           (grtext (+ n 2) (nth (+ lshift n) lalist))
  160.           (setq n (1+ n))
  161.      )
  162.      (if (> (- (length lalist) lshift 17) 0)
  163.          (grtext 20 " next   ")
  164.          (grtext 20 "        ")
  165.      )
  166.      (if (> lshift 0)(grtext 19 " last  ")(grtext 19 "        "))
  167. )
  168. (defun layers (x lalist)
  169. (setq n 0 lshift 0 lname1 "0" done nil ostr "" prestr "Set to Layer <done>: ")
  170. (if (= sdscrn "Y")(layside)(setq sdscrn nil))
  171. (if (= x "B")(setq prestr "\nInsert block <done>: "))
  172. (if (= x "ST")(setq prestr "\nText style <done>: "))
  173. (if (= x "L")(setq prestr "\nLayer linetype <CONTINUOUS>: "))
  174. (if (= x "LT")(setq prestr (strcat "\nLayer name(s) for linetype " ostr1 " <" (getvar "clayer") "> : ")))
  175. (if (= x "R")(setq prestr "\nView to Restore <done>: "))
  176. (if (= x "F")(setq prestr "\nLayer(s) to FREEZE <done>: "))
  177. (if (= x "ON")(setq prestr "\nLayer(s) to turn ON <done>: "))
  178. (if (= x "T")(setq prestr "\nLayer(s) to THAW <done>: "))
  179. (if (= x "OFF")(setq prestr "\nLayer(s) to turn OFF <done>: "))
  180. (if (member x '("LISTS" "LLIST" "LIST"))(setq prestr " " olist '()))
  181. (princ prestr)
  182. (while (not done)
  183.   (setq input1 (grread) n 0 newstr "")
  184.   (cond
  185.       ((and (equal input1 '(4 19)) (> lshift 0))
  186.            (setq lshift (- lshift 17))
  187.            (if (= sdscrn "Y")(layside))
  188.       )
  189.       ((and (equal input1 '(4 20))(> (- (length lalist) lshift 17) 0))
  190.            (setq lshift (+ lshift 17))
  191.            (if (= sdscrn "Y")(layside))
  192.       )
  193.       ((= (car input1) 4)
  194.            (if (> (strlen ostr) 0)
  195.               (if (/= x "LLIST")(progn 
  196.                   (setq ostr (strcat ostr ","))(princ ","))
  197.                   (progn (princ " ")(setq olist (cons ostr olist) ostr "")
  198.               )) 
  199.            )
  200.            (if (and (<= (setq temp (+ (cadr input1) -2 lshift)) 
  201.                      (length lalist)) (> (cadr input1) 1))
  202.                (setq newstr (nth temp lalist))(setq newstr "0"))
  203.       )
  204.       ((or (and (/= x "LLIST" )(equal input1 '(2 32)))(equal input1 '(6 0)) (equal input1 '(2 13))) (setq done 'T))
  205.       ((equal input1 '(2 8)) (setq ostr (substr ostr 1 (1- (strlen ostr))))
  206.           (princ "\n ")(princ "\n ")(princ "\n ")(princ prestr)(princ ostr))
  207.       ((= (car input1) 2) (setq newstr (chr (cadr input1))))
  208.       ((and chlaypt (= (car input1) 3)) (setq ostr "" done 't))
  209.   )
  210.   (if (and newstr (not (equal input1 '(2 32)))(not (equal newstr '(2 8))))(setq ostr (strcat ostr newstr)))
  211.   (if (and newstr (= x "LLIST" )(equal input1 '(2 32)))(setq olist (cons (strcase ostr) olist) ostr ""))
  212.   (princ newstr)
  213.   (if (and (member x '("S" "LISTS" "R" "L" "ST" "B"))
  214.       (> (strlen ostr) 0) (= (car input1) 4))(setq done 'T))
  215. )
  216. (if (and (not (member x '("LT" "B" "ST" "L" "R" "LISTS" "LIST" "LLIST" "H"))))
  217.  (command "layer" x ostr ""))
  218. (menucmd "s=header")(menucmd "s=s")
  219. (if (= x "R")(if (/= ostr "")(command "'view" "r" ostr)))
  220. (if (= x "LT")(if (null ostr)(setq ostr (getvar "clayer"))))
  221. (if (= x "ST")(if (/= ostr "")(command "text" "S" ostr)))
  222. (if (/= x "B")(princ))
  223. (if (= x "B")(if (/= ostr "")(command "insert" ostr)))
  224. (if (= x "LLIST")(setq olist (cons (strcase ostr) olist)))
  225. )
  226. (defun trim (strng1)
  227.  (setq n 1)(while (and (/= (substr strng1 (1+ n) 1) " ") (<= n (strlen strng1)))(setq n (1+ n)))(substr strng1 1 n)
  228. )
  229. (defun trimr (strng1)
  230.  (setq n (strlen strng1))(while (and (= (substr strng1 n 1) " ")(>= n 1))(setq n (1- n)))(substr strng1 1 n)
  231. )
  232. (defun gettable (tbltyp stat)
  233.  (setq temp (cdr (assoc 2 (tblnext (setq tbltyp (strcase tbltyp)) t))) alist '() stat (strcase stat))
  234.  (while temp 
  235.    (if (or (/= tbltyp "LAYER")(and (= tbltyp "LAYER")(= stat "")))
  236.      (setq alist (cons temp alist))
  237.      (cond 
  238.       ((and (not (minusp (cdr (assoc 62 (tblsearch "layer" temp)))))(= stat "OFF"))(setq alist (cons temp alist)))
  239.       ((and (minusp (cdr (assoc 62 (tblsearch "layer" temp))))(= stat "ON"))(setq alist (cons temp alist)))
  240.       ((and (= (cdr (assoc 70 (tblsearch "layer" temp))) 65)(= stat "T"))(setq alist (cons temp alist)))
  241.       ((and (not (minusp (cdr (assoc 62 (tblsearch "layer" temp)))))(= stat "F"))(setq alist (cons temp alist)))
  242.      )
  243.    )
  244.    (setq temp (cdr (assoc 2 (tblnext tbltyp))))
  245.  )
  246.  (setq alist (reverse alist))
  247. )
  248. (defun lays (lay)(if (/= (getvar "useri3") 0)(progn (nl levvari "/archp/levvari")(levvari lay))(command "layer" "m" lay ""))(princ))
  249. (defun arh ()(command "attedit" "" "" "" "" "l" "a" "0" "")(princ))
  250. (defun rd ()(if redraw1 (progn (command "redraw")(setq redraw1 nil)))(princ))
  251. (defun dd (filen)(princ (strcat drive filen))(strcat drive filen))
  252. (defun dd3 (filen)(if (/= (getvar "useri4") 0)(setq subdr "/arch3d")(setq subdr "/arch2d"))(princ (setq temp (strcat drive subdr filen))) temp)
  253. (defun nl (funct filen)
  254.  (cond ((null funct)(load (strcat drive filen)))((= funct "")(load (strcat drive filen))))(princ)
  255. )
  256. (defun xyonly (p1 p2)(list (car p1)(cadr p1)(caddr p2)))
  257. (defun eltk ()
  258.   (grtext 25 "Elev =")(grtext 26 (rtos (getvar "elevation")))
  259.   (grtext 27 "Thick =")(grtext 28 (rtos (getvar "thickness")))
  260.   (if (and (/= (getvar "useri3") 0)(= (strcase (getvar "menuname")) "ARCH"))(progn (grtext 29 "Level =")(grtext 30 (rtos (getvar "useri2") 2 0))))
  261.   (if (and (= (getvar "useri1") 1)(= (strcase (getvar "menuname")) "ARCH"))(progn
  262.    (grtext 31 "TopWall=")(grtext 32 (rtos (getvar "userr2")))
  263.    (grtext 33 "TopWind=")(grtext 34 (rtos (getvar "userr3")))
  264.   ))
  265. )
  266. (defun in-line (key prevpt)
  267.  (cond  ((= key "I")(nl int "/cci/int")(int)) ((= key "R")(nl off "/cci/off")(off))
  268.   ((= key "IR")(nl refint "/cci/refint")(refint)) ((= key "MR")(nl refmid "/cci/refmid")(refmid))
  269.   ((= key "M")(nl mid "/cci/mid")(mid))((= key "F")(nl midway "/cci/midway")(midway))
  270.   ((= key "RR")(nl offway "/cci/offway")(offway))
  271.   ((= key "P")(nl at-angle "/cci/at-angle")(setq p2 (at-angle))
  272.     (command "line" prevpt p2 "")(setq calpt (getvar "lastpoint"))
  273.     (entdel (entlast))(setq calpt calpt)
  274.   )
  275.   ((= key "CAL")(nl calc "/cci/calc")(setq calcapply 't p2 (calc))
  276.     (command "line" prevpt p2 "")(setq calpt (getvar "lastpoint"))
  277.     (entdel (entlast))(setq calpt calpt)
  278.   ))
  279. )
  280. (defun S::STARTUP ()
  281.  (setvar "cmdecho" 0)(setvar "coords" 2)(setvar "menuecho" 1)(setvar "flatland" 0)
  282.  (if (/= (getvar "useri5") 0)(progn (setvar "useri5" 0)(setvar "cmdecho" 0)(setvar "aperture" 5)
  283.   (setvar "pickbox" 3)(setvar "expert" 0)(setvar "highlight" 1)(setvar "blipmode" 1)))
  284.  (princ (strcat "\nElevation="(rtos (getvar "elevation"))))
  285.  (princ (strcat "  Thickness="(rtos (getvar "thickness"))))
  286.  (if (/= (getvar "useri3") 0)(progn (setq level (getvar "useri2"))(princ (strcat "  Level=" (rtos (getvar "useri2") 2 0)))))
  287.  (if (/= (getvar "useri1") 0)(princ "  3D=ON"))
  288.  (if metric (cond ((equal (getvar "userr4") 1. 0.001)(princ "  Base Unit = 1 Meter"))((equal (getvar "userr4") 100. 0.001)(princ "  Base Unit = 1 Centimeter"))
  289.   ((equal (getvar "userr4") 1000. 0.001)(princ "  Base Unit = 1 Millimeter"))((equal (getvar "userr4") 40. 0.001)(princ "  Base Unit = 1 Inch"))))
  290.  (if (equal (getvar "useri1") 0 0.001)(if (= (strcase (getvar "menuname")) "ARCH")(princ "\n3D=OFF (use 3D SETUP to turn on) ")))
  291.  (if (/= (getvar "useri1") 0)(princ (strcat "\nWall Base=" (rtos (getvar "userr1")))))
  292.  (if (/= (getvar "useri1") 0)(princ (strcat "  Wall Top=" (rtos (getvar "userr2")))))
  293.  (if (/= (getvar "useri1") 0)(princ (strcat "  Window Top=" (rtos (getvar "userr3")))))
  294.  (command "undefine" "save")(command "undefine" "end")(eltk)(setq S::STARTUP nil)(princ)
  295. )(grtext -2 spaces)
  296. (if sun386i (setq drive (getenv "ACAD"))
  297.  (setq drive (strcat (substr (getvar "acadprefix") 1 2) "/autoarch")))(princ)
  298.