home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / mar94cad.zip / TIP960.LSP < prev    next >
Lisp/Scheme  |  1994-02-15  |  4KB  |  112 lines
  1. ; TIP960.LSP: DATUM.LSP   Datum Dimensioning   (c)1994, Kevin Kronschnabl
  2.  
  3. ;; The DATUM command enters the coordinate dimensioning mode.  From there you
  4. ;; can use the DATUM dimensioning subcommands to setup and create a dimension.
  5. ;; Each subcommand can be abbreviated to the capital letters shown.  A space 
  6. ;; or RETURN will prompt for the start and placement points of the dimension.  
  7. ;; 
  8. ;;       Origin       -  Sets the origin to be dimensioned from
  9. ;;       Dimension    -  Dimensions a point from the origin
  10. ;;       Reset origin -  Resets the origin back to the world coordinate system
  11. ;;       ?            -  This help Screen
  12. ;; IMPORTANT:
  13. ;; When finished dimensioning your drawing, use reset origin to reestablish
  14. ;; the drawings original 0,0,0 point.
  15. ;;------------------------------------------------------------------------
  16. ; Internal error handler defined locally
  17.  
  18. (defun *error* (msg)
  19.    (princ "error: ")
  20.    (princ msg)
  21.    (terpri)
  22.    (princ)
  23. )
  24. (defun err (s)                   ; If an error (such as CTRL-C) occurs
  25.    ; while this command is active...   
  26.    (if (/= s "Function canceled")
  27.       (if (= s "quit / exit abort")
  28.          (princ)
  29.          (princ (strcat "\nError: " s))
  30.       )
  31.    )
  32.    (RVAR)
  33.    (princ)
  34. );defun
  35. ;;------------------------------------------------------------------------
  36. ;get variables
  37. (defun GVAR()
  38.    (setq FDIA (getvar "filedia")) ;get system settings
  39.    (setq CMDE (getvar "cmdecho"))
  40.    (setq MNUE (getvar "menuecho"))
  41.    (setq EXPT (getvar "expert"))
  42.    (setq CCLR (getvar "cecolor"))
  43.    (setq CLTP (getvar "celtype"))
  44.    (setq UCSO (getvar "ucsorg"))
  45. );defun
  46. ;;------------------------------------------------------------------------
  47. ;set variables
  48. (defun SVAR()
  49.    (setvar "cmdecho" 1)         ;turn command echo off
  50.    (setvar "menuecho" 1)        ;turn menu echo off
  51. );defun
  52. ;;------------------------------------------------------------------------
  53. ;reset variables
  54. (defun RVAR()
  55.    (setvar "cmdecho" CMDE)
  56.    (setvar "cmdecho" MNUE)
  57. );defun
  58. ;;------------------------------------------------------------------------
  59. ;read help
  60. (defun DHLP(/ FILE LINE)
  61.    (setq FILE (open (findfile "datum.lsp") "r")
  62.       LINE (read-line FILE)
  63.    );setq
  64.    (repeat 24
  65.       (setq LINE (substr LINE 4 75))
  66.       (write-line LINE)
  67.       (setq LINE (read-line FILE))
  68.    );repeat
  69.    (close FILE)
  70.    (princ)
  71. );defun
  72.  
  73. ;;------------------------------------------------------------------------
  74. ;main body
  75. (defun C:DATUM(/ QST ORG)
  76.    (setvar "cmdecho" 0)
  77.    (initget "ORIGIN DIM DIMENSION RESET O D R ?")
  78.    (setq QST (getkword "\nSelect option - Origin/Dimension/Reset origin/?/<Dimension>: "))
  79.    (if (= QST "?")
  80.       (progn
  81.          ;      (command "type" (strcat (findfile "datum.hlp") "|more"))
  82.          (DHLP)
  83.          (initget "ORIGIN DIM DIMENSION RESET O D R")
  84.          (setq QST (getkword "\nSelect option - Origin/Dimension/Reset origin/<Dimension>: "))
  85.       );progn
  86.    );if
  87.    (if (or (= QST nil) (= QST "D") (= QST "DIM") (= QST "DIMENSION"))
  88.       (progn
  89.          (initget 1)
  90.          (setq SPT (getpoint "\nPick starting point: "))
  91.          (initget 1)
  92.          (setq EPT (getpoint "\nPick ending point: " SPT))
  93.          (command "dim" "ordinate" SPT EPT "")
  94.          (command "exit")
  95.       );progn
  96.    );if
  97.    (if (or (= QST "O") (= QST "ORIGIN"))
  98.       (progn
  99.          (initget 1)
  100.          (setq ORG (getpoint "\nPick the Origin Point: "))
  101.          (command "ucs" "origin" ORG)
  102.       );progn
  103.    );if
  104.    (if (or (= QST "R") (= QST "RESET"))
  105.       (progn
  106.          (command "ucs" "world")
  107.          (princ "\nThe origin has been reset...")
  108.       );progn
  109.    );if
  110.    (princ)
  111. ); end datum.lsp
  112.