home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / GR / GR505.ZIP / LSP.EXE / ACAD.LSP next >
Text File  |  1988-03-11  |  4KB  |  150 lines

  1. (setq name "Allen")
  2. ;
  3. ;               TURN OFF/ON COMMAND LINE
  4. (defun echooff()
  5.     (setq echo (getvar "cmdecho"))
  6.     (setvar "cmdecho" 0)
  7. )
  8. (defun echoon()
  9.     (setvar "cmdecho" echo)
  10. )
  11. ;        CHANGE N FROM RADIANS TO DEGREES
  12. (defun rtd(n)
  13.     (* n (/ 180.0 PI))
  14. )
  15. ;        ROUTINE TO DRAW A SQUARE
  16. (defun c:square(/ pt1 pt2 pt3 pt4 len)
  17. (graphscr)
  18. (echooff)
  19.     (setq pt1 (getpoint"\nLower left corner ? "))
  20.     (setq len (getdist pt1 "\nLength of a side ? "))
  21.     (setq pt2 (polar pt1 0.0 len))
  22.     (setq pt3 (polar pt2 (/ PI 2.0) len))
  23.     (setq pt4 (polar pt3 PI len))
  24. (setvar"blipmode"0)
  25.     (command "line" pt1 pt2 pt3 pt4 "C")
  26. (setvar"blipmode"1)
  27. (echoon)
  28. )
  29. ;        ROUTINE TO DRAW A RECTANGLE
  30. (defun c:rectangle (/ pt1 pt2 pt3 pt4)
  31.     (graphscr)
  32.     (echooff)
  33.         (setq pt1 (getpoint "\nFirst point of rectangle..."))(terpri)
  34.         (setq pt3 (getcorner "Second corner of rectangle..."pt1))
  35.         (setq pt2 (list (car pt1)(cadr pt3)))
  36. (setvar"blipmode"0)
  37.         (setq pt4 (list (car pt3)(cadr pt1)))
  38.     (command"line" pt1 pt2 pt3 pt4 "c")
  39. (setvar"blipmode"1)
  40.     (echoon)
  41. )
  42. ;        EDIT TEXT WITHOUT TYPING THE WHOLE LINE
  43. ;
  44. (defun C:CHGTEXT (/ p l n e os as ns st s nsl osl sl si chf chm cont)
  45.     (graphscr)
  46.     (echooff)
  47.    (setq chm 0 p (ssget))            ; Select objects
  48.    (if p (progn                      ; If any objects selected
  49.       (setq cont t)
  50.       (while cont
  51.          (setq osl (strlen (setq os (getstring "\nOld string ? " t))))
  52.          (if (= osl 0)
  53.             (princ "Null input is invalid! ")
  54.         (setq cont nil)
  55.          )
  56.       )
  57.       (setq nsl (strlen (setq ns (getstring "\nNew string ? " t))))
  58.       (setq l 0 n (sslength p))
  59.       (while (< l n)                 ; For each selected object...
  60.          (if (= "TEXT"               ; Look for TEXT entity type (group 0)
  61.                 (cdr (assoc 0 (setq e (entget (ssname p l))))))
  62.             (progn
  63.                (setq chf nil si 1)
  64.                (setq s (cdr (setq as (assoc 1 e))))
  65.                (while (= osl (setq sl (strlen
  66.                              (setq st (substr s si osl)))))
  67.                   (if (= st os)
  68.                       (progn
  69.                         (setq s (strcat (substr s 1 (1- si)) ns
  70.                                         (substr s (+ si osl))))
  71.                         (setq chf t)    ; Found old string
  72.                         (setq si (+ si nsl))
  73.                       )
  74.                       (setq si (1+ si))
  75.                   )
  76.                )
  77.                (if chf (progn        ; Substitute new string for old
  78.                   (setq e (subst (cons 1 s) as e))
  79.                   (entmod e)         ; Modify the TEXT entity
  80.                   (setq chm (1+ chm))
  81.                ))
  82.             )
  83.          )
  84.          (setq l (1+ l))
  85.       )
  86.    ))
  87.    (princ "You changed ")                ; Print total lines changed
  88.    (princ chm)
  89.    (princ " text line(s), ")(princ name)
  90.    (terpri)
  91. (echoon)
  92. )
  93. ;            ROUTINE TO SIGN YOUR NAME
  94. (defun c:signit (/ x cp)
  95.     (echooff)
  96.     (graphscr)
  97.     (setq cp (getpoint"\nEnter the center point of your name.."))
  98. (princ"....Thank You, ")(princ name)(princ"!   ")
  99.         (command"text""s""scripts""c" cp "90" name)
  100. (setvar"blipmode"0)
  101. (setvar"highlight"0)
  102.     (setq x (getvar "cdate"))
  103.     (setq x (rtos x 2 0))
  104.     (setq date (strcat
  105.     (substr x 5 2) "/"  ;month
  106.     (substr x 7 2) "/"  ;day
  107.     (substr x 3 2)))    ;year
  108.     (command "text" "" date)
  109.         (command"text""s""simplex""c" cp "" "")
  110. (setvar"blipmode"1)
  111. (setvar"highlight"1)
  112. (echoon)
  113. )
  114. ;            ROUTINE JUST TO PRINT THE DATE
  115. (defun c:dateit (/ cp x)
  116.     (echooff)
  117.     (graphscr)
  118.    (setq cp (getpoint"\nEnter the center point of the date....."))
  119.    (princ"Thank You, ")(princ name)(princ"!   ")
  120.         (setq x (getvar "cdate"))
  121.         (setq x (rtos x 2 0))
  122.         (setq date (strcat
  123.         (substr x 5 2) "/"  ;month
  124.         (substr x 7 2) "/"  ;day
  125.         (substr x 3 2)))    ;year
  126.             (command "text""c" cp "90" date)
  127.     (echoon)
  128. )
  129. ;        THIS ROUTINE ERASES THE EXTENTS OF YOUR DRAWING!
  130. (defun c:ew (/ l u)
  131.     (graphscr)
  132.     (echooff)
  133. (setvar"blipmode"0)
  134. (setvar"highlight"0)
  135.         (setq l (getvar "extmin"))
  136.         (setq u (getvar "extmax"))
  137.             (command "erase""c" l u "")
  138.             (command "zoom""a")
  139.             (command "redraw")
  140.          (princ"O.K., ")(princ name)(princ", all done....!   ")
  141. (setvar"blipmode"1)
  142. (setvar"highlight"1)
  143.     (echoon)
  144. )
  145. ;            CLEAN THE ATOMLIST
  146. (defun c:clean ()
  147.     (setq atomlist (member 'c:clean atomlist))
  148.     'Done
  149. )
  150.