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