home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 168.img / ACAD3.ZIP / SSX.LSP < prev    next >
Lisp/Scheme  |  1988-09-09  |  4KB  |  86 lines
  1. ;-----------------------------------------------------------------------------+
  2. ;                                                                             |
  3. ;                                  SSX.LSP                                    |
  4. ;                                                                             |
  5. ;           Larry Knott          Version 2.0             7/18/88              |
  6. ;                                                                             |
  7. ;    "(SSX)" -  Easy SSGET filter routine.                                    |
  8. ;                                                                             |
  9. ;    Creates a selection set.  Either type "(SSX)" at the "Command:" prompt   |
  10. ;    to create a "previous" selection set or type "(SSX)" in response to any  |
  11. ;    "Select objects:" prompt.  You may use the functions "(A)" to add        |
  12. ;    entities and "(R)" to remove entities from a selection set during object |
  13. ;    selection.  More than one filter criteria can be used at a time.         |
  14. ;                                                                             |
  15. ;-----------------------------------------------------------------------------|
  16.  
  17. ;--------------------------- INTERNAL ERROR HANDLER --------------------------|
  18.  
  19. (defun ssx-err (s)                    ; If an error (such as CTRL-C) occurs
  20.                                       ; while this command is active...
  21. (if (/= s "Function cancelled")
  22.     (princ (strcat "\nError: " s))
  23. )
  24. (setq *error* olderr)                 ; Restore old *error* handler
  25. (princ)
  26. )
  27.  
  28. ;-------------------------- ADD AND REMOVE FUNCTIONS -------------------------|
  29.  
  30. (defun r() (command "r") (ssx))
  31. (defun a() (command "a") (ssx))
  32.  
  33. ;-------------------------------- MAIN PROGRAM -------------------------------|
  34.  
  35. (defun ssx (/ olderr t1 t2 t3 f1 f2)
  36. (setq olderr *error* *error* ssx-err t1 T f2 'f1)
  37. (while t1
  38.   (initget "Block Color Entity LAyer LType Style Thickness")
  39.   (setq t1 (getkword
  40.      "\n>>Block name/Color/Entity/LAyer/LType/Style/Thickness: "))
  41.   (setq t2
  42.      (cond
  43.         ((eq t1 "Block")      2)   ((eq t1 "Color")     62)
  44.         ((eq t1 "Entity")     0)   ((eq t1 "LAyer")      8)
  45.         ((eq t1 "LType")      6)   ((eq t1 "Style")      7)
  46.         ((eq t1 "Thickness") 39)))
  47.   (initget 1)
  48.   (setq t3
  49.      (cond
  50.         ((= t2  2)  (getstring "\n>>Block name: "))
  51.         ((= t2 62)  (initget "?")
  52.                     (while
  53.                        (or (eq (setq t3 (getint "\n>>Color number/<?>: ")) "?")
  54.                            (null t3)
  55.                            (> t3 256)
  56.                            (< t3 0))
  57.                            (textscr)
  58.           (princ "\n                                                     ")
  59.           (princ "\n                 Color number   |   Standard meaning ")
  60.           (princ "\n                ________________|____________________")
  61.           (princ "\n                                |                    ")
  62.           (princ "\n                       0        |      <BYBLOCK>     ")
  63.           (princ "\n                       1        |      Red           ")
  64.           (princ "\n                       2        |      Yellow        ")
  65.           (princ "\n                       3        |      Green         ")
  66.           (princ "\n                       4        |      Cyan          ")
  67.           (princ "\n                       5        |      Blue          ")
  68.           (princ "\n                       6        |      Magenta       ")
  69.           (princ "\n                       7        |      White         ")
  70.           (princ "\n                    8...255     |      -Varies-      ")
  71.           (princ "\n                      256       |      <BYLAYER>     ")
  72.           (princ "\n                                               \n\n\n")
  73.                           (initget "?")) t3)
  74.         ((= t2  0)  (getstring "\n>>Entity type: "))
  75.         ((= t2  8)  (getstring "\n>>Layer name: "))
  76.         ((= t2  6)  (getstring "\n>>Linetype name: "))
  77.         ((= t2  7)  (getstring "\n>>Text style name: "))
  78.         ((= t2 39)  (getreal   "\n>>Thickness: "))
  79.         (T          nil)))
  80.   (if t3 (setq f1 (cons (cons t2 t3) f1)))
  81. )
  82. (setq f2 (ssget "x" (eval f2)))
  83. (setq *error* olderr)
  84. (if (and f1 f2) f2 (progn (princ "\n0 found.") (prin1)))
  85. )
  86.