home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-385-Vol-1of3.iso / d / dicogo.zip / MAKEPTS.LSP < prev    next >
Lisp/Scheme  |  1991-09-30  |  2KB  |  74 lines
  1. ;
  2. ;               MAKEPTS.LSP
  3. ;
  4. ;   Writes northing and easting to a file and places a point number
  5. ;   on the drawing by allowing the user to pick the endpoints of drawing
  6. ;   entities.
  7. ;
  8. ;   Copyright (c) 1991, D I Management Corporation
  9. ;
  10. ;
  11. ;
  12. ;
  13. ;
  14. (prompt "\nLoading . . . .\n")
  15.  
  16. (defun makerr (s)
  17.  
  18.    (if (/= s "Function cancelled")
  19.        (princ (strcat "\nError: " s))
  20.    )
  21.    (command "osnap" "none")
  22.    (setvar "cmdecho" ocmd)
  23.    (setq *error* olderr)
  24.    (princ)
  25. )
  26.  
  27. (defun C:makepts ()
  28.     (setq ocmd (getvar "cmdecho"))
  29.     (setvar "cmdecho" 0)
  30.     (setq olderr  *error*
  31.           *error* makerr)
  32.     (setq nbr 1)
  33.     (setq nmbr (itoa nbr))
  34.     (setq pfx (getvar "dwgprefix"))             ; Get the output file name
  35.     (prompt "\nEnter points file name -- no extension.")
  36.     (setq fil (getstring "\n(Data will be appended to existing file:) "))
  37.     (setq cfl (strcat pfx fil ".pts"))
  38.     (setq datafile (open cfl "a"))              ; Open the data file
  39.     (setq t1 "Text Height: <default = ")
  40.     (setq t2 " >: ")
  41.     (setq t3 (getvar "textsize"))
  42.     (terpri)
  43.     (setq tht (getreal (strcat t1 (rtos t3 2 2) t2)))
  44.     (if (= tht nil)
  45.         (setq tht t3))
  46.     (setq finis "Y")
  47.     (while (= finis "Y")
  48.         (command "osnap" "end")
  49.         (setq p1 (getpoint "\nCoordinates of which point? "))  ; Get the point
  50.         (setq pquest (strcat "\nPoint number <" nmbr ">: "))   ; Get the number
  51.         (setq nmbr (getstring pquest))
  52.         (if (/= nmbr "")
  53.             (setq nbr (atoi nmbr)))
  54.         (setq e (rtos (car p1) 2 4))        ; Build the output string
  55.         (setq n (rtos (cadr p1) 2 4))
  56.         (setq nmbr (itoa nbr))
  57.         (setq coord (strcat nmbr "    " n "    " e))
  58.         (command "osnap" "none")
  59.         (setq p2 (getpoint "\nPoint number location: "))
  60.         (command "text" "m" p2 tht "" nmbr)                ; Write the point
  61.         (write-line coord datafile)
  62.         (setq finis (getstring "\nContinue <Y>: "))
  63.         (if (= finis "")
  64.             (setq finis "Y"))
  65.         (setq nbr (atoi nmbr))         ; Increment point number
  66.         (setq nbr (+ nbr 1))
  67.         (setq nmbr (itoa nbr))
  68.     )                                  ; All done
  69.     (close datafile)                   ; Close data file
  70.     (setq *error* olderr)              ; Restore old *error* handler
  71.     (setvar "cmdecho" ocmd)            ; Restore old cmdecho
  72.     (princ)
  73. )
  74.