home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / autocad / autolo12.arj / AUTOLOG.LSP next >
Lisp/Scheme  |  1991-09-12  |  31KB  |  721 lines
  1. ;Copyright (c) 1991 Andy Harrover
  2. ;Version 1 - 29 July 1991
  3. ;Version 1.1 - 1 September 1991 (Support for all hatches)
  4. ;Version 1.2 - 12 September 1991 bug fix
  5. ;
  6. (defun C:AUTOLOG ()
  7. ; the following is an error-trapping routine for hatching
  8.   (defun hatch ()
  9.     (setq hatyes 0)
  10.        (cond
  11.           ((= hatyes 0)
  12.             (setq pat(getstring "\nHatch Pattern: "))
  13.             (hatchit)
  14.           );end this case
  15.           ((= hatyes 2)
  16.              (prompt "\nNot Found!..Try Again")
  17.              (setq pat(getstring "\nHatch Pattern: "))
  18.              (hatchit)
  19.           );end this case
  20.        );end cond
  21.     );defun
  22. ;hatching subroutine
  23.    (defun hatchit ()
  24.           (cond             
  25.                    ((or (= pat "ar-conc") (= pat "AR-CONC"))
  26.                    (setq pscala 0.04)
  27.                    (command "hatch" pat pscala "" (entlast) "")        
  28.                    (setq hatyes 1)
  29.                 );end this case
  30.                    ((or (= pat "ar-b816") (= pat "AR-B816"))
  31.                    (setq pscala 0.04)
  32.                    (command "hatch" pat pscala "" (entlast) "")        
  33.                    (setq hatyes 1)
  34.                 );end this case
  35.                    ((or (= pat "ar-b816c") (= pat "AR-B816C"))
  36.                    (setq pscala 0.04)
  37.                    (command "hatch" pat pscala "" (entlast) "")        
  38.                    (setq hatyes 1)
  39.                 );end this case
  40.                    ((or (= pat "ar-b88") (= pat "AR-B88"))
  41.                    (setq pscala 0.04)
  42.                    (command "hatch" pat pscala "" (entlast) "")        
  43.                    (setq hatyes 1)
  44.                 );end this case
  45.                    ((or (= pat "ar-brelm") (= pat "AR-BRELM"))
  46.                    (setq pscala 0.04)
  47.                    (command "hatch" pat pscala "" (entlast) "")        
  48.                    (setq hatyes 1)
  49.                 );end this case
  50.                    ((or (= pat "ar-brstd") (= pat "AR-BRSTD"))
  51.                    (setq pscala 0.04)
  52.                    (command "hatch" pat pscala "" (entlast) "")        
  53.                    (setq hatyes 1)
  54.                 );end this case
  55.                    ((or (= pat "ar-hbone") (= pat "AR-HBONE"))
  56.                    (setq pscala 0.04)
  57.                    (command "hatch" pat pscala "" (entlast) "")        
  58.                    (setq hatyes 1)
  59.                 );end this case
  60.                    ((or (= pat "ar-parq1") (= pat "AR-PARQ1"))
  61.                    (setq pscala 0.04)
  62.                    (command "hatch" pat pscala "" (entlast) "")        
  63.                    (setq hatyes 1)
  64.                 );end this case
  65.                    ((or (= pat "ar-rroof") (= pat "AR-RROOF"))
  66.                    (setq pscala 0.04)
  67.                    (command "hatch" pat pscala "" (entlast) "")        
  68.                    (setq hatyes 1)
  69.                 );end this case
  70.                    ((or (= pat "ar-rshke") (= pat "AR-RSHKE"))
  71.                    (setq pscala 0.04)
  72.                    (command "hatch" pat pscala "" (entlast) "")        
  73.                    (setq hatyes 1)
  74.                 );end this case
  75.                    ((or (= pat "box") (= pat "BOX"))
  76.                    (setq pscala 0.04)
  77.                    (command "hatch" pat pscala "" (entlast) "")        
  78.                    (setq hatyes 1)
  79.                 );end this case
  80.                    ((or (= pat "brass") (= pat "BRASS"))
  81.                    (setq pscala 0.04)
  82.                    (command "hatch" pat pscala "" (entlast) "")        
  83.                    (setq hatyes 1)
  84.                 );end this case
  85.                    ((or (= pat "brstone") (= pat "BRSTONE"))
  86.                    (setq pscala 0.04)
  87.                    (command "hatch" pat pscala "" (entlast) "")        
  88.                    (setq hatyes 1)
  89.                 );end this case
  90.                    ((or (= pat "cork") (= pat "CORK"))
  91.                    (setq pscala 1)
  92.                    (command "hatch" pat pscala "" (entlast) "")        
  93.                    (setq hatyes 1)
  94.                 );end this case
  95.                    ((or (= pat "earth") (= pat "EARTH"))
  96.                    (setq pscala 1)
  97.                    (command "hatch" pat pscala "" (entlast) "")        
  98.                    (setq hatyes 1)
  99.                 );end this case
  100.                    ((or (= pat "escher") (= pat "ESCHER"))
  101.                    (setq pscala 0.04)
  102.                    (command "hatch" pat pscala "" (entlast) "")        
  103.                    (setq hatyes 1)
  104.                 );end this case
  105.                    ((or (= pat "flex") (= pat "FLEX"))
  106.                    (setq pscala 0.04)
  107.                    (command "hatch" pat pscala "" (entlast) "")        
  108.                    (setq hatyes 1)
  109.                 );end this case
  110.                    ((or (= pat "grass") (= pat "GRASS"))
  111.                    (setq pscala 0.04)
  112.                    (command "hatch" pat pscala "" (entlast) "")        
  113.                    (setq hatyes 1)
  114.                 );end this case
  115.                    ((or (= pat "grate") (= pat "GRATE"))
  116.                    (setq pscala 0.04)
  117.                    (command "hatch" pat pscala "" (entlast) "")        
  118.                    (setq hatyes 1)
  119.                 );end this case
  120.                    ((or (= pat "hex") (= pat "HEX"))
  121.                    (setq pscala 0.04)
  122.                    (command "hatch" pat pscala "" (entlast) "")        
  123.                    (setq hatyes 1)
  124.                 );end this case
  125.                    ((or (= pat "honey") (= pat "HONEY"))
  126.                    (setq pscala 0.04)
  127.                    (command "hatch" pat pscala "" (entlast) "")        
  128.                    (setq hatyes 1)
  129.                 );end this case
  130.                    ((or (= pat "hound") (= pat "HOUND"))
  131.                    (setq pscala 0.04)
  132.                    (command "hatch" pat pscala "" (entlast) "")        
  133.                    (setq hatyes 1)
  134.                 );end this case
  135.                    ((or (= pat "INSUL") (= pat "insul"))
  136.                    (setq pscala 0.04)
  137.                    (command "hatch" pat pscala "" (entlast) "")        
  138.                    (setq hatyes 1)
  139.                 );end this case
  140.                    ((or (= pat "line") (= pat "LINE"))
  141.                    (setq pscala 0.04)
  142.                    (command "hatch" pat pscala "" (entlast) "")        
  143.                    (setq hatyes 1)
  144.                 );end this case
  145.                    ((or (= pat "NET") (= pat "net"))
  146.                    (setq pscala 0.04)
  147.                    (command "hatch" pat pscala "" (entlast) "")        
  148.                    (setq hatyes 1)
  149.                 );end this case
  150.                    ((or (= pat "net3") (= pat "NET3"))
  151.                    (setq pscala 0.04)
  152.                    (command "hatch" pat pscala "" (entlast) "")        
  153.                    (setq hatyes 1)
  154.                 );end this case
  155.                    ((or (= pat "PLAST") (= pat "plast"))
  156.                    (setq pscala 0.04)
  157.                    (command "hatch" pat pscala "" (entlast) "")        
  158.                    (setq hatyes 1)
  159.                 );end this case
  160.                    ((or (= pat "plasti") (= pat "PLASTI"))
  161.                    (setq pscala 0.04)
  162.                    (command "hatch" pat pscala "" (entlast) "")        
  163.                    (setq hatyes 1)
  164.                 );end this case
  165.                    ((or (= pat "sacncr") (= pat "SACNCR"))
  166.                    (setq pscala 0.04)
  167.                    (command "hatch" pat pscala "" (entlast) "")        
  168.                    (setq hatyes 1)
  169.                 );end this case
  170.                    ((or (= pat "SQUARE") (= pat "square"))
  171.                    (setq pscala 0.04)
  172.                    (command "hatch" pat pscala "" (entlast) "")        
  173.                    (setq hatyes 1)
  174.                 );end this case
  175.                    ((or (= pat "stars") (= pat "STARS"))
  176.                    (setq pscala 0.04)
  177.                    (command "hatch" pat pscala "" (entlast) "")        
  178.                    (setq hatyes 1)
  179.                 );end this case
  180.                    ((or (= pat "STEEL") (= pat "steel"))
  181.                    (setq pscala 0.04)
  182.                    (command "hatch" pat pscala "" (entlast) "")        
  183.                    (setq hatyes 1)
  184.                 );end this case
  185.                    ((or (= pat "swamp") (= pat "SWAMP"))
  186.                    (setq pscala 0.04)
  187.                    (command "hatch" pat pscala "" (entlast) "")        
  188.                    (setq hatyes 1)
  189.                 );end this case
  190.                    ((or (= pat "trans") (= pat "TRANS"))
  191.                    (setq pscala 0.04)
  192.                    (command "hatch" pat pscala "" (entlast) "")        
  193.                    (setq hatyes 1)
  194.                 );end this case
  195.                    ((or (= pat "TRIANG") (= pat "triang"))
  196.                    (setq pscala 0.04)
  197.                    (command "hatch" pat pscala "" (entlast) "")        
  198.                    (setq hatyes 1)
  199.                 );end this case
  200.                    ((or (= pat "zigzag") (= pat "ZIGZAG"))
  201.                    (setq pscala 0.04)
  202.                    (command "hatch" pat pscala "" (entlast) "")        
  203.                    (setq hatyes 1)
  204.                 );end this case
  205.                    ((or (= pat "dots") (= pat "DOTS"))
  206.                    (setq pscalb 1)
  207.                    (command "hatch" pat pscalb "" (entlast) "")
  208.                    (setq hatyes 1)
  209.                 );end this case
  210.                    ((or (= pat "dolmit") (= pat "DOLMIT"))
  211.                    (setq pscalc 1)
  212.                    (command "hatch" pat pscalc "" (entlast) "")
  213.                    (setq hatyes 1)
  214.                 );end this case
  215.                    ((or (= pat "u") (= pat "U"))
  216.                    (setq pscald 0.1)
  217.                    (command "hatch" pat "" pscald "" (entlast) "")
  218.                    (setq hatyes 1)
  219.                 );end this case
  220.                    ((or (= pat "mudst") (= pat "MUDST"))
  221.                    (setq pscale 0.5)
  222.                    (command "hatch" pat pscale "" (entlast) "")
  223.                    (setq hatyes 1)
  224.                 );end this case
  225.                    ((or (= pat "ar-sand") (= pat "AR-SAND"))
  226.                    (setq pscalf 0.06)
  227.                    (command "hatch" pat pscalf "" (entlast) "")
  228.                    (setq hatyes 1)
  229.                 );end this case
  230.                    ((or (= pat "brick") (= pat "BRICK"))
  231.                    (setq pscalg 1)
  232.                    (command "hatch" pat pscalg "" (entlast) "")
  233.                    (setq hatyes 1)
  234.                 );end this case
  235.                    ((or (= pat "cross") (= pat "CROSS"))
  236.                    (setq pscalh 1)
  237.                    (command "hatch" pat pscalh "" (entlast) "")
  238.                    (setq hatyes 1)
  239.                 );end this case          
  240.                    ((or (= pat "clay") (= pat "CLAY"))
  241.                    (setq pscali 2)
  242.                    (command "hatch" pat pscali "" (entlast) "")
  243.                    (setq hatyes 1)
  244.                 );end this case
  245.                    ((or (= pat "angle") (= pat "ANGLE"))
  246.                    (setq pscali 2)
  247.                    (command "hatch" pat pscali "" (entlast) "")
  248.                    (setq hatyes 1)
  249.                 );end this case
  250.                    ((or (= pat "ANSI31") (= pat "ansi31"))
  251.                    (setq pscali 2)
  252.                    (command "hatch" pat pscali "" (entlast) "")
  253.                    (setq hatyes 1)
  254.                 );end this case
  255.                    ((or (= pat "ansi32") (= pat "ANSI32"))
  256.                    (setq pscali 2)
  257.                    (command "hatch" pat pscali "" (entlast) "")
  258.                    (setq hatyes 1)
  259.                 );end this case
  260.                    ((or (= pat "ANSI33") (= pat "ansi33"))
  261.                    (setq pscali 2)
  262.                    (command "hatch" pat pscali "" (entlast) "")
  263.                    (setq hatyes 1)
  264.                 );end this case
  265.                    ((or (= pat "ANSI34") (= pat "ansi34"))
  266.                    (setq pscali 2)
  267.                    (command "hatch" pat pscali "" (entlast) "")
  268.                    (setq hatyes 1)
  269.                 );end this case
  270.                    ((or (= pat "ANSI35") (= pat "ansi35"))
  271.                    (setq pscali 2)
  272.                    (command "hatch" pat pscali "" (entlast) "")
  273.                    (setq hatyes 1)
  274.                 );end this case
  275.                    ((or (= pat "ANSI36") (= pat "ansi36"))
  276.                    (setq pscali 2)
  277.                    (command "hatch" pat pscali "" (entlast) "")
  278.                    (setq hatyes 1)
  279.                 );end this case
  280.                    ((or (= pat "ANSI37") (= pat "ansi37"))
  281.                    (setq pscali 2)
  282.                    (command "hatch" pat pscali "" (entlast) "")
  283.                    (setq hatyes 1)
  284.                 );end this case
  285.                    ((or (= pat "ANSI38") (= pat "ansi38"))
  286.                    (setq pscali 2)
  287.                    (command "hatch" pat pscali "" (entlast) "")
  288.                    (setq hatyes 1)
  289.                 );end this case
  290.                    ((or (= pat "dash") (= pat "DASH"))
  291.                    (setq pscali 1)
  292.                    (command "hatch" pat pscali "" (entlast) "")
  293.                    (setq hatyes 1)
  294.                 );end this case
  295.                   ((= hatyes 0)
  296.                   (setq hatyes 2)
  297.                   (prompt "\nNot Found!..Try Again")
  298.                   (hatch)
  299.                 );end this cond
  300.             ):end cond
  301.        );end defun
  302. (command "limits" "-5,-5" "20,20")
  303. (command "zoom" "all")
  304. (command "setvar" "cmdecho" "0")
  305. (command "pline" "1,1" "1,9" "2.5,9" "2.5,1" "1,1" "")   ;draws well
  306. (command "pline" "2,1" "2,10" "2.5,10" "2.5,9" "")
  307. (command "pedit" (entlast) "w" ".02" "")
  308. (command "pline" "2.5,9" "2.5,1" "")
  309. (command "pedit" (entlast) "w" ".02" "")
  310. (command "pline" "2.5,1" "3,1" "3,9" "2.5,9" "c");draws construction side
  311. (command "pline" "2.5,9" "7.8488,9" "");draws ground surface
  312. (command "style" "b" "romans" ".07" "" "" "" "" "" "");sets style for well construction label
  313. (setq totald(getreal "\nENTER TOTAL WELL DEPTH: "))
  314. (setq scale(/ totald 8))
  315. ;This section draws the well construction details and labels them
  316. ;<------------------------------------------------->
  317. (prompt "\n<------BACKFILL DETAILS------>  ")
  318. (prompt "\nIs there any backfill at the bottom of the well? ")
  319. (setq backans(getstring "\n(Y or N) "))
  320.      (if (or(= backans "y") (= backans "Y"))
  321.         (progn
  322.          (setq bfill(getreal "\nThickness of Backfill: "))
  323.          (setq bfilld(/ bfill scale))
  324.          (setq two 2)
  325.          (setq three 3)
  326.          (setq one 1)
  327.          (setq bfilld(+ 1 bfilld))
  328.          (setq llf(list two one))
  329.          (setq lrf(list three one))
  330.          (setq ulf(list two bfilld))
  331.          (setq urf(list three bfilld))
  332.          (command "pline" llf lrf urf ulf llf "");draws backfill
  333.          (hatch)
  334.          (command "pline" ulf urf "")
  335.          (command "pedit" (entlast) "w" ".01" "")
  336.          ;adds tick at top of fill and depth to fill
  337.          (command "line" urf "@0.1<0" "")
  338.          (prompt "\nDepth to Fill:")
  339.          (setq text(read-line))
  340.          (setq txtr 3.2)
  341.          (setq textpt(list txtr bfilld))
  342.          (command "text" textpt "0" text);adds label
  343.          ;labels fill type
  344.          (setq ftexty(- bfilld 0.11))
  345.          (setq flp(list three ftexty))
  346.          (command "line" flp "@0.1<0" "")
  347.          (setq tposx 3.2)
  348.          (setq textpos(list tposx ftexty))
  349.          (prompt "\nTYPE OF BACKFILL  ")
  350.          (setq bfiltyp(read-line))
  351.          (command "text" textpos "0" bfiltyp) ;adds label
  352.          (setq lry ftexty)
  353.          (setq fans(getstring "\nAnother line of text? (Y or N) "))
  354.                     (while (or(= fans "y") (= fans "Y")) ;while loop
  355.                     (prompt "\nNext label: ")
  356.                     (prompt "\nMaximum of 14 characters  ")
  357.                     (setq flabel(read-line))
  358.                     (setq lry(- lry 0.11))
  359.                     (setq lstart(list tposx lry))
  360.                     (command "text" lstart "0" flabel) ;adds formation label
  361.                     (setq fans(getstring "\nAnother line of text? (Y or N) "))
  362.                     );ends while loop
  363.       );progn
  364.          (progn
  365.              (setq bfilld 1)
  366.          );progn       
  367.   );ends if loop
  368. ;<-------------------------------------------------->
  369. ;<-------------------SandPack---------------------->
  370. (prompt "\n<------SANDPACK DETAILS------>  ")
  371. (setq sandpd(getreal "\nThickness of Sandpack: "))
  372. (setq sandpd(/ sandpd scale))
  373. (setq sandpd(+ sandpd bfilld))
  374. (setq lx 2.5)
  375. (setq rx 3)
  376. (setq lls(list lx bfilld))
  377. (setq lrs(list rx bfilld))
  378. (setq uls(list lx sandpd))
  379. (setq urs(list rx sandpd))
  380. (command "pline" lls lrs urs uls lls "")
  381. (hatch)
  382. (command "pline" uls urs "")
  383. (command "pedit" (entlast) "w" ".01" "")
  384. ;adds tick at top of sand and depth to sand
  385. (command "line" urs "@0.1<0" "")
  386. (prompt "\nDepth to Sandpack: ")
  387. (setq text(read-line))
  388. (setq txtr 3.2)
  389. (setq textpt(list txtr sandpd))
  390. (command "text" textpt "0" text);adds depth label
  391. ;labels sand type
  392. (setq ftexty(- sandpd 0.11))
  393. (setq tposx 3.2)
  394. (setq textpos(list tposx ftexty))
  395. (prompt "\nSandpack Label: ")
  396. (setq sandtyp(read-line));prompt for sandpack label
  397. (command "text" textpos "0" sandtyp) ;adds label
  398.            (setq lry ftexty)
  399. (setq fans(getstring "\nAnother line of text? (Y or N) "))
  400.            (while (or(= fans "y") (= fans "Y")) ;while loop
  401.            (prompt "\nNext label: ")
  402.            (prompt "\nMaximum of 14 characters  ")
  403.            (setq flabel(read-line))
  404.            (setq lry(- lry 0.11))
  405.            (setq lstart(list tposx lry))
  406.            (command "text" lstart "0" flabel) ;adds formation label
  407.            (setq fans(getstring "\nAnother line of text? (Y or N) "))
  408.            );ends while loop
  409. ;<-------------------------------------------------->
  410. ;
  411. ;<----------------------------------END SAND PACK SECTION
  412. ;<-------------------START OF SCREEN SECTION
  413. (prompt "\n<------SCREEN DETAILS------>  ")
  414. (setq screeni(getreal "\nScreening interval: "))
  415. (setq screeni(/ screeni scale))
  416. (setq screen(+ screeni bfilld))
  417. (setq lx 2.5)
  418. (setq rx 3)
  419. (setq llsc(list two bfilld))
  420. (setq lrsc(list lx bfilld))
  421. (setq ulsc(list two screen))
  422. (setq ursc(list lx screen))
  423. (command "pline" llsc lrsc ursc ulsc llsc "");draws screen
  424. (hatch)
  425. (command "pline" ulsc ursc "")
  426. (command "pedit" (entlast) "w" ".01" "")
  427. (command "style" "b" "romans" ".07" "" "" "" "" "" "");sets style
  428. ;adds line for screen label
  429. (setq scl(/ screeni 2))
  430. (setq sclb(+ scl bfilld))
  431. (setq sclc(list lx sclb))
  432. (command "line" sclc "@0.7<0" "")
  433. (setq scly(- sclb 0.04))
  434. (setq sclx 3.3);changed from 0.5
  435. (setq textpt(list sclx scly))
  436. ;labels screen type
  437. (prompt "\nScreen Label: ")
  438. (setq sctyp(read-line));prompt for screentype
  439. (command "text" textpt "0" sctyp) ;adds label<---------scaley
  440. (setq lry scly)
  441. (setq fans(getstring "\nAnother line of text? (Y or N) "))
  442.            (while (or(= fans "y") (= fans "Y")) ;while loop
  443.            (prompt "\nNext label: ")
  444.            (prompt "\nMaximum of 14 characters  ")
  445.            (setq flabel(read-line))
  446.            (setq lry(- lry 0.11))
  447.            (setq lstart(list sclx lry))
  448.            (command "text" lstart "0" flabel) ;adds formation label
  449.            (setq fans(getstring "\nAnother line of text? (Y or N) "))
  450.            );ends while loop
  451. ;<-----------------------------------------------
  452. ;<---------------BENTONITE SEAL
  453. (prompt "\n<------BENTONITE DETAILS------>  ")
  454. (setq bent(getreal "\nBentonite Thickness: "))
  455. (setq bent(/ bent scale))
  456. (setq bent(+ sandpd bent));  bent is cumulative thickness
  457. (setq lx 2.5)
  458. (setq rx 3)
  459. (setq llb(list lx sandpd))
  460. (setq lrb(list rx sandpd))
  461. (setq ulb(list lx bent))
  462. (setq urb(list rx bent))
  463. (command "pline" llb lrb urb ulb llb "")
  464. (hatch)
  465. (command "pline" ulb urb "")
  466. (command "pedit" (entlast) "w" ".01" "")
  467. ;adds tick at top of bentonite
  468. (command "line" urb "@0.1<0" "")
  469. (prompt "\nDepth to Bentonite: ")
  470. (setq text(read-line))
  471. (setq txtr 3.2)
  472. (setq textpt(list txtr bent))
  473. (command "text" textpt "0" text);adds depth label
  474. ;labels sand type
  475. (setq ftexty(- bent 0.11))
  476. (setq tposx 3.2)
  477. (setq textpos(list tposx ftexty))
  478. (prompt "\nBentonite Label: ")
  479. (setq benl(read-line));prompt for sandpack label
  480. (command "text" textpos "0" benl) ;adds label
  481.            (setq lry ftexty)
  482. (setq fans(getstring "\nAnother line of text? (Y or N) "))
  483.            (while (or(= fans "y") (= fans "Y")) ;while loop
  484.            (prompt "\nNext label: ")
  485.            (prompt "\nMaximum of 14 characters  ")
  486.            (setq flabel(read-line))
  487.            (setq lry(- lry 0.11))
  488.            (setq lstart(list tposx lry))
  489.            (command "text" lstart "0" flabel) ;adds formation label
  490.            (setq fans(getstring "\nAnother line of text? (Y or N) "))
  491.            );ends while loop
  492. ;<---------GROUT----------------------------------
  493. (prompt "\n<------GROUT DETAILS------>  ")
  494. (setq lx 2.5)
  495. (setq rx 3)
  496. (setq nine 9)
  497. (setq llg(list lx bent))
  498. (setq lrg(list rx bent))
  499. (setq ulg(list lx nine))
  500. (setq urg(list rx nine))
  501. (command "pline" llg lrg urg ulg llg "")
  502. (prompt "\nTHIS SECTION FILLS IN THE GROUT")
  503. (hatch)
  504. (setq diff(- nine bent))
  505. (setq div(/ diff 2))
  506. (setq midgy(+ div bent))
  507. (setq midg(list rx midgy))
  508. ;adds tick at middle of grout
  509. (command "line" midg "@0.1<0" "")
  510. (prompt "\nGrout Label: ")
  511. (setq groutl(read-line));prompt for grout label
  512. (setq tposx(+ rx 0.14))
  513. (setq ftexty(- midgy 0.02))
  514. (setq textpos(list tposx ftexty))
  515. (command "text" textpos "0" groutl) ;adds label
  516.            (setq lry ftexty)
  517. (setq fans(getstring "\nAnother line of text? (Y or N) "))
  518.            (while (or(= fans "y") (= fans "Y")) ;while loop
  519.            (prompt "\nNext label: ")
  520.            (prompt "\nMaximum of 14 characters  ")
  521.            (setq flabel(read-line))
  522.            (setq lry(- lry 0.09))
  523.            (setq lstart(list tposx lry))
  524.            (command "text" lstart "0" flabel) ;adds formation label
  525.            (setq fans(getstring "\nAnother line of text? (Y or N) "))
  526.            );ends while loop
  527. ;<--------------LITHOLOGY-------------------------
  528. (prompt "\nTHIS SECTION IS FOR GEOLOGY")
  529. (setq garbage(getstring "\nHit any key to continue..."))
  530. (command "move" "w" "0,0" "20,20" "" "1,1" "0,0")
  531. (setq a(getreal "\nThickness of layer: ")) 
  532. (setq thick(/ a scale))
  533. (setq x 0)
  534. (setq xr 1)
  535. (setq ul(list x thick))
  536. (setq ur(list xr thick)) 
  537. (command "pline" "0,0" ul ur "1,0" "c");draws first formation
  538. (hatch)
  539. (command "pline" ul ur "")
  540. (command "pedit" (entlast) "w" ".01" "")
  541. (command "style" "b" "romans" ".07" "" "" "" "" "" "");sets style for well material label
  542. (command "line" ul "@.105<180" "");draws tick at top of layer
  543. (setq try (- thick 0.05))
  544. (setq trx -0.15)
  545. (setq tstart(list trx try))
  546. (prompt "\nDepth to formation:")
  547. (setq fdepth(read-line))
  548. (command "text" "j" "r" tstart "0" fdepth) ;adds depth label
  549. (setq lry(- try 0.11))
  550. (setq lstart(list trx lry))
  551. (prompt "\nLabel for formation: ")
  552. (prompt "\nMaximum of 14 characters  ")
  553. (setq flabel(read-line))
  554. (command "text" "j" "r" lstart "0" flabel) ;adds formation label
  555. (setq fans(getstring "\nAnother line of text? (Y or N) "))
  556.      (while (= fans "y") ;while loop
  557.      (prompt "\nNext label for formation: ")
  558.      (prompt "\nMaximum of 14 characters  ")
  559.      (setq flabel(read-line))
  560.      (setq lry(- lry 0.11))
  561.      (setq lstart(list trx lry))
  562.      (command "text" "j" "r" lstart "0" flabel) ;adds formation label
  563.      (setq fans(getstring "\nAnother line of text? (Y or N) "))
  564.      );ends while loop
  565. ;
  566. (setq ydis thick)
  567. ;(setq answer "y")
  568.       (setq answer (getstring "\nANOTHER LAYER (Y or N)"))
  569.       (while (or (= answer "y") (= answer "Y"))    ;while loop
  570.       (setq a(getreal "\nThickness of layer: ")) 
  571.       (setq temp(/ a scale))
  572.       (setq thick (+ temp ydis))
  573.       (setq eight 8)
  574.            (if (> thick eight)
  575.              (progn
  576.                    (prompt "\nTHICKNESS EXCEEDS GROUND SURFACE!")
  577.                (prompt "\n AutoLog can Perform rounding to top of surface")
  578.      (setq answer (getstring "\nTRY AGAIN or AUTOROUND? (T or A): "))
  579.       (if (or (= answer "t") (= answer "T"))
  580.               (progn
  581.                    (setq answer "y")
  582.               );closes progn
  583.               (progn
  584.                    (setq thick 8)
  585.                 (setq ll(list x ydis))
  586.                 (setq ul(list x thick))
  587.                 (setq ur(list xr thick)) 
  588.                 (setq lr(list xr ydis))
  589.                 (command "pline" ll ul ur lr "c")
  590.                 (setq ydis (+ ydis temp))
  591.                 (hatch)
  592.                 (command "pline" ul ur "")
  593.                 (command "pedit" (entlast) "w" ".01" "")
  594.                 (command "line" ul "@.105<180" "");draws tick at top of layer
  595.                 (setq try (- thick 0.05))
  596.                 (setq trx -0.15)
  597.                 (setq tstart(list trx try))
  598.                 (prompt "\nDepth to formation:")
  599.                 (setq fdepth(read-line))
  600.                 ;(command "style" "a" "romans" ".1" "" "" "" "" "" "")
  601.                 (command "text" "j" "r" tstart "0" fdepth) ;adds depth label
  602.                 (setq lry(- try 0.11))
  603.                 (setq lstart(list trx lry))
  604.                 (prompt "\nLabel for formation: ")
  605.                 (prompt "\nMaximum of 14 characters  ")
  606.                 (setq flabel(read-line))
  607.                 (command "text" "j" "r" lstart "0" flabel) ;adds formation label
  608.                 (setq fans(getstring "\nAnother line of text? (Y or N) "))
  609.                      (while (= fans "y") ;while loop
  610.                      (prompt "\nNext label for formation: ")
  611.                      (prompt "\nMaximum of 14 characters  ")
  612.                      (setq flabel(read-line))
  613.                      (setq lry(- lry 0.11))
  614.                      (setq lstart(list trx lry))
  615.                      (command "text" "j" "r" lstart "0" flabel) ;adds formation label
  616.                      (setq fans(getstring "\nAnother line of text? (Y or N) "))
  617.                      );ends while loop
  618.                 );closes progn
  619.                );closes if
  620.              );ends progn
  621.              (progn
  622.                 (setq ll(list x ydis))
  623.                 (setq ul(list x thick))
  624.                 (setq ur(list xr thick)) 
  625.                 (setq lr(list xr ydis))
  626.                 (command "pline" ll ul ur lr "c")
  627.                 (setq ydis (+ ydis temp))
  628.                 (hatch)
  629.                 (command "pline" ul ur "")
  630.                 (command "pedit" (entlast) "w" ".01" "")
  631.                 (command "line" ul "@.105<180" "");draws tick at top of layer
  632.                 (setq try (- thick 0.05))
  633.                 (setq trx -0.15)
  634.                 (setq tstart(list trx try))
  635.                 (prompt "\nDepth to formation:")
  636.                 (setq fdepth(read-line))
  637.                 ;(command "style" "a" "romans" ".1" "" "" "" "" "" "")
  638.                 (command "text" "j" "r" tstart "0" fdepth) ;adds depth label
  639.                 (setq lry(- try 0.11))
  640.                 (setq lstart(list trx lry))
  641.                 (prompt "\nLabel for formation: ")
  642.                 (prompt "\nMaximum of 14 characters  ")
  643.                 (setq flabel(read-line))
  644.                 (command "text" "j" "r" lstart "0" flabel) ;adds formation label
  645.                 (setq fans(getstring "\nAnother line of text? (Y or N) "))
  646.                      (while (= fans "y") ;while loop
  647.                      (prompt "\nNext label for formation: ")
  648.                      (prompt "\nMaximum of 14 characters  ")
  649.                      (setq flabel(read-line))
  650.                      (setq lry(- lry 0.11))
  651.                      (setq lstart(list trx lry))
  652.                      (command "text" "j" "r" lstart "0" flabel) ;adds formation label
  653.                      (setq fans(getstring "\nAnother line of text? (Y or N) "))
  654.                      );ends while loop
  655.                 (setq answer (getstring "\nANOTHER LAYER (Y or N)"))
  656.             );ends progn
  657.          );ends if
  658.       );ends while loop
  659. (command "move" "w" "-3,-3" "20,20" "" "1.5,3.99" "1.89,4.95")
  660. (command "move" "w" "-3,-3" "20,20" "" ".3878,.95" "1.65,.5")
  661. (command "pline" "0,0" "0,11" "8.5,11" "8.5,0" "0,0" "");draws box
  662. (command "pedit" (entlast) "w" ".02" "")
  663. (command "style" "a" "romans" ".1" "" "" "" "" "" "");sets style for labels
  664. (prompt "\nCOMPLETED BY: ")
  665. (setq name(read-line))
  666. (command "text" ".281,10.016" "0" "BY: ") 
  667. (command "text" ".523,10.016" "0" name) 
  668. (prompt "\nDATE COMPLETED: ")
  669. (setq date(read-line))
  670. (command "text" ".281,10.259" "0" "COMPLETION DATE: ") 
  671. (command "text" "1.77,10.259" "0" date) 
  672. (prompt "\nDRILLING METHOD: ")
  673. (setq method(read-line))
  674. (command "text" ".281,10.496" "0" "DRILL METHOD: ") 
  675. (command "text" "1.48,10.496" "0" method) 
  676. (prompt "\nDRILLER: ")
  677. (setq driller(read-line))
  678. (command "text" ".281,10.75" "0" "DRILLER: ") 
  679. (command "text" "1,10.75" "0" driller) 
  680. (prompt "\nGROUND SURFACE ELEVATION: ")
  681. (setq gelev(read-line))
  682. (command "text" "6,8.55" "0" "SURFACE ELEVATION: ") 
  683. (command "text" "7.6,8.55" "0" gelev) 
  684. (command "text" "0.4438,0.1" "0" "Depth Measured from Ground Surface") 
  685. (command "text" "1.79,8.55" "0" "Lithology") 
  686. (prompt "\nPROJECT: ")
  687. (setq project(read-line))
  688. (command "text" "5.247,10.75" "0" "PROJECT: ") 
  689. (command "text" "6.02,10.75" "0" project) 
  690. (prompt "\nWELL NUMBER: ")
  691. (setq number(read-line))
  692. (command "text" "5.247,10.259" "0" "WELL NUMBER: ") 
  693. (command "text" "6.42,10.259" "0" number) 
  694. (prompt "\nWELL TYPE: ")
  695. (setq wellt(read-line))
  696. (command "text" "5.247,10.496" "0" "WELL TYPE: ") 
  697. (command "text" "6.158,10.496" "0" wellt) 
  698. (prompt "\nLOCATION: ")
  699. (setq loc(read-line))
  700. (command "text" "5.247,10.016" "0" "LOCATION: ") 
  701. (command "text" "6.0442,10.016" "0" loc) 
  702. (command "pline" "0,9.88" "8.5,9.88" "")
  703. (command "pedit" (entlast) "w" ".02" "")
  704. (command "pline" "3.1522,8.75" "3.3,8.75" "")
  705. (command "style" "b" "romans" ".07" "" "" "" "" "" "")
  706. (prompt "\nWELL CASING MATERIAL: ")
  707. (setq ctype(read-line))
  708. (command "text" "3.35,8.74" "0" "CASING MATERIAL: ") 
  709. (command "text" "4.33,8.74" "0" ctype) 
  710. (command "pline" "3.1522,9.5" "3.3,9.5" "")
  711. (prompt "\nTOP OF CASING ELEVATION: ")
  712. (setq celev(read-line))
  713. (command "text" "3.35,9.47" "0" "TOP OF CASING ELEVATION: ") 
  714. (command "text" "4.87,9.47" "0" celev) 
  715. (command "pline" "3.6522,7.5" "3.75,7.5" "")
  716. (prompt "\nBOREHOLE DIAMETER: ")
  717. (setq bd(read-line))
  718. (command "text" "3.81,7.46" "0" "BOREHOLE DIAMETER: ") 
  719. (command "text" "5,7.46" "0" bd) 
  720. );ends program
  721.