Liren Large Software Subsidy 13/13.iso/p/p024/6.img/BONUS1.LIB/ALIAS.LSP

Text File | 1993-02-09 | 5.4 KB | 188 lines

;;;   ALIAS.lsp
;;;   ¬⌐┼v (C) 1988-1992  Autodesk ñ╜Ñq
;;;
;;;   Ñ╗╡{ªíñwÑ╤ Autodesk ñ╜Ñq╡∙ÑU¬⌐┼v, ╢╚⌐≤ñU¡z▒í¬pñUÑi▒┬╗P▒zíu│\ÑiívíC
;;;   ╗╒ñUñú▒oÑHÑ⌠ª≤º╬ªí╡oªµ⌐╬ÑX¬⌐ª╣╡{ªí¬║íu¡∞⌐l╜Xív; ª²ñ╣│\▒zªb»S⌐w¡lÑ═
;;;   ¬║ñuº@ñW╡▓ªXª╣╡{ªí¬║íuÑ╪¬║╜Xív¿╧Ñ╬íCª│├÷│o├■¡lÑ═ñuº@¬║▒°Ñ≤ªpñU:
;;;
;;;   ( i)  │]¡pñW╗Pñuº@ñW¼╥»┬║Θ░w╣∩ Autodesk ñ╜Ñq¬║▓ú½~íC
;;;   (ii)  ╕ⁿª│íu¬⌐┼v  (C) 1988-1992  Autodesk ñ╜Ñqív¬║¬⌐┼v│qºiíC
;;;
;;;
;;;
;;;   AUTODESKñ╜Ñq┤ú¿╤ª╣╡{ªí╢╚¿╤º@íu├■ªⁿív¬║░╤ª╥, ª╙ÑBñú▒╞░úª│Ñ⌠ª≤┐∙╗~¬║
;;;   Ñi»αíCAUTODESKñ╜Ñq»Sª╣º_╗{Ñ⌠ª≤»S⌐wÑ╬│~ñº╛A║┘⌐╩, ÑHñ╬░╙╖~╛P░Γ⌐╥┴⌠ºt
;;;   ÑX¿π¬║½O├╥íCAUTODESKñ╜ÑqªP«╔ÑτñúÑX¿πª╣╡{ªí░⌡ªµ«╔ñ@⌐wñú╖|íuññ┬_ív⌐╬
;;;   íuº╣Ñ■╡L╗~ív¬║½O├╥íC
;;;
;;;
;;;   by Jan S. Yoder
;;;   29 January 1990

;;;-------------------------------------------------------------------------;
;;; DESCRIPTION
;;;
;;; List all of the aliases found in the file "acad.pgp" if it can be found
;;; in AutoCAD's search path, which means that they are available in AutoCAD.
;;; This routine lists them in a two column format, pausing after every 20
;;; lines.
;;;
;;;-------------------------------------------------------------------------;

;;;
;;; Look for an external definition file in AutoCAD's search path
;;; al_lfx == Alias_Look_For_Xfile
;;;
(defun al_lfx (f_name r_or_w /)
  ;; Look for f_name in AutoCAD's search paths.
  (if (= r_or_w "w")
    (if (setq temp (open f_name r_or_w))
      temp                            ; Return file descriptor
      (progn
        (princ (strcat "\n\t╡L¬k╢}▒╥íu" f_name "ívÑH¿╤╝gñJíC "))
        (exit)
      )
    )
    (if (setq lfile (findfile f_name))
      (if (setq temp (open lfile r_or_w))
        temp                          ; Return file descriptor
        (progn
          (princ (strcat "\n\t╡L¬k╢}▒╥íu" f_name "ívÑH¿╤┼¬¿·íC "))
          (exit)
        )
      )
      nil                             ; or nil
    )
  )
)
;;;
;;; Print the alias in a two column format, pausing after twenty lines.
;;;
(defun al_pr1 (/ j al_str c_str tmpstr )
  (setq j      0
        al_str ""
        c_str  ""
  )
  (while (/= (setq tmpstr (substr line (setq j (1+ j)) 1)) ",")
    (if (/= tmpstr " ")
      (setq al_str (strcat al_str tmpstr))
    )
  )
  (while (and (/= (setq tmpstr (substr line (setq j (1+ j)) 1)) "")
              (/= tmpstr ";")
              (/= tmpstr ",")
              (/= tmpstr "\n")
         )
    (if (and (/= tmpstr " ") (/= tmpstr "*") (/= tmpstr "\t"))
      (setq c_str (strcat c_str tmpstr))
    )
  )
  (if (= (strlen c_str) 0) (setq c_str "<Null>"))
  (if (< (strlen al_str) 12)
    (progn
      (repeat (- 12 (strlen al_str)) (setq al_str (strcat al_str  " ")))
    )
  )
  (if (< (strlen c_str) 10)
    (repeat (- 10 (strlen c_str)) (setq c_str (strcat c_str  " ")))
    (setq first T)
  )
  (if first
    (princ (strcat "\n    " al_str "= " c_str ))
    (princ (strcat "\t\t    " al_str "= " c_str ))
  )
  (if (and first (< (strlen c_str) 11))
    (setq lineno (1+ lineno)
           first nil)
    (setq first T)
  )
  (if (and (= lineno 20) first)
    (progn
      (princ "\n\n\t<▒╡ñU¡╢> ")
      (grread)
      (terpri)
      (setq lineno 0)
    )
  )
)
;;;
;;; Main function
;;;
(defun c:alias (/ al_err al_oe s al_oce aliasi lineno first line lfile)

  (setq al_ver "1.00a")               ; Reset this local if you make a change.
  ;;
  ;; Internal error handler defined locally
  ;;
  (defun al_err (s)                   ; If an error (such as CTRL-C) occurs
                                      ; while this command is active...
    (if (/= s "Function cancelled")
      (princ (strcat "\n┐∙╗~: " s))
    )
    (if al_oe                         ; If an old error routine exists
      (setq *error* al_oe)            ; then, reset it
    )
    (setq aliasi (close aliasi))
    (setvar "cmdecho" al_oce)         ; Reset command echoing on error
    (princ)
  )
  ;;
  ;; Body of alias function
  ;;
  (if *error*                         ; Set our new error handler
    (setq al_oe *error* *error* al_err)
    (setq *error* al_err)
  )

  ;;
  ;; Set command echoing off.
  ;;
  (setq al_oce (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  ;;
  ;; The default file name is "acad.pgp".
  ;; Look for it in AutoCAD's search paths.
  ;;

  (setq aliasi (al_lfx "acad.pgp" "r"))

  (if aliasi
    (progn
      (setq lineno 0
            first T
      )
      (if textpage (textpage) (textscr))    ; For Release 10
      (princ (strcat
        "\n    ALIAS ¬⌐Ñ╗ " al_ver ", (c) 1990  Autodesk ñ╜Ñq "))
      (princ (strcat
        "\n    ÑHñUªCÑ▄ñºíuºOªWív╗PíuÑ~│í½ⁿÑOív½Y⌐w╕q⌐≤"
        "\n    íu"
                     lfile "ívíC \n"))
      (while (setq line (read-line aliasi))
        ;; Check each line for leading semi-colon
        (if (and (/= (substr line 1 1) ";")     ; Leading semi-colon?
                 (/= (substr line 1 1) "")      ; Blank line?
                 (/= (substr line 1 1) "\n"))   ; Carriage return?

          (al_pr1)
        )
      )
      (princ "\n")
      (princ "\n½÷íuÑ⌠╖N┴ΣívÑH¬≡ª^╣╧º╬╡e¡▒íC")
      (grread)
      (princ "\r                                          ")
      (graphscr)
    )
    ;; else
    (progn
      (princ "\nºΣñú¿∞⌐╬╡L¬k┼¬¿·íuacad.pgpív└╔íC ")
    )
  )
  (setq aliasi (close aliasi))
  (if al_oce (setvar "cmdecho" al_oce))
  (princ)
)

(princ "\n\tíuC:ALIASívñw╕ⁿñJ; ╜╨ÑH ALIAS ▒╥░╩½ⁿÑOíC")
(princ)