home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / APOG / ITEM.ZIP / ITEM.LSP
Encoding:
Lisp/Scheme  |  1994-04-16  |  1.4 KB  |  51 lines
  1. (defun $d_err (msg)
  2.     (if (/= msg "Function cancelled")
  3.         (princ (strcat "\nError: " msg))
  4.     )
  5.     (setvar "BLIPMODE" $blip)
  6.     (setvar "OSMODE" $osnap)
  7.     (command "_.UNDO" "_E")
  8.     (setvar "CMDECHO" $ehco)
  9.     (setvar "CLAYER" $layer)
  10.     (setq *error* olderr)
  11.     (princ)
  12. )
  13.  
  14. ;;;---------------------- Main Program ---------------------
  15.  
  16. (defun init ()
  17.     (setq olderr *error*)
  18.     (setq $blip (getvar "BLIPMODE"))
  19.     (setq $osnap (getvar "OSMODE"))
  20.     (setq $ortho (getvar "ORTHOMODE"))
  21.     (setq $echo (getvar "CMDECHO"))
  22.     (setq $layer (getvar "CLAYER"))
  23.     (command "_.UNDO" "_GROUP")
  24.     (setvar "BLIPMODE" 0)
  25.     (setvar "OSMODE" 0)
  26.     (setvar "ORTHOMODE" 0)
  27.     (setvar "CMDECHO" 0)
  28.     (command "_.LAYER" "_M" "note" "_C" "4" "" "")
  29. )
  30.  
  31. (defun c:item (/ pt1 pt2 text)
  32.     (init)
  33.     (setq pt1 (getpoint "\nPick arrow end of leader: ")
  34.             pt2 (getpoint pt1 "\nPick bubble location: "))
  35.     (command "pline" pt1 "w" "0" (* 0.04 (getvar "dimscale"))
  36.         (polar pt1 (angle pt1 pt2)(* 0.12 (getvar "dimscale")))
  37.         "_Width" "0" "0" 
  38.         (polar pt2 (angle pt2 pt1)(* 0.1875 (getvar "dimscale"))) "")
  39.     (command "circle" pt2 (* 0.1875 (getvar "dimscale")))
  40.     (setq text (getstring "\nEnter item number: "))
  41.     (command "text" "j" "m" pt2 (* 0.11 (getvar "dimscale")) "0" text)
  42.     (setvar "BLIPMODE" $blip)
  43.     (setvar "OSMODE" $osnap)
  44.     (setvar "ORTHOMODE" $ortho)
  45.     (command "_.UNDO" "_E")
  46.     (setvar "CMDECHO" $echo)
  47.     (setvar "CLAYER" $layer)
  48.     (setq *error* olderr)
  49.     (princ)
  50. )
  51.