;;;   ssx.lsp
;;;
;;;   Larry Knott                        Version 2.0    7/18/88
;;;   Carl Bethea & Jan S. Yoder         Version 3.0
;;;   Enhancements to (ssx).
;;;   15 March 1990
;;;
;;;--------------------------------------------------------------------------;
;;; Beschreibung
;;;                              SSX.LSP
;;;
;;;   "(SSX)" - einfache SSGET Filter Routine
;;;
;;;   Dieses Programm erzeugt einen Auswahlsatz.
;;;
;;;   Tippen Sie entweder "ssx" in der Anfrage "Befehl:" um einen
;;;   "vorhergehenden" Auswahlsatz zu erzeugen, oder gebeben Sie
;;;   "(ssx)" auf eine beliebige "Obiekte auswaehlen:"-Befehlsanfrage ein.
;;;   Sie koennen die Funktion "(a)" { append } oder die Funktion
;;;   "(r)" {remove} verwenden, um dem Auswahlsatz Elemente hinzuzufuegen"(a)",
;;;   oder Elemente aus dem Auswahlsatz zu entfernen. "(r)"
;;;
;;;   SSX gibt entweder einen Auswahlsatz gleich dem des gewaehlten
;;;   Elements, oder einen der dem angewendeten Fliter entspricht.
;;;
;;;   Die Syntax ist:
;;;
;;;     Befehl: ssx
;;;     Objekt whlen/<Keines>: (RETURN)
;;; *  >>Blockname/FArbe/Entity/FLag/LAyer/LType/Pick/Stil/Objekthhe/Vektor:
;;;
;;;   Wenn  Sie die "RETURN" bei der ersten Befehlsanfrage eingeben,
;;;   bekommen Sie einen leeren Auswahlsatz zurueck.
;;;   Sie koennen jedoch Elemente waehlen.
;;;   Wenn Sie ein Element waehlen, wird die Liste der gueltigen
;;;   Wahlmoeglichkeiten durch (ssget "x") in der Komando Zeile angezeigt.
;;;
;;; *   Select object/<None>:  (a LINE selected)
;;; *   Filter: ((0 . "LINE") (8 . "0") (39 . 2.0) (62 . 1) (210 0.0 0.0 1.0))
;;; *   >>Block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector:
;;;
;;;   An diesem Punkt kann jeder der Filter durch Eingabe des Buchstabens
;;;   gefolgt von "RETURN" ausgeschaltet werden.
;;;
;;; *   >>Layer name to add/<RETURN to remove>: (RETURN)
;;;
;;; *   Filter: ((0 . "LINE") (39 . 2.0) (62 . 1) (210 0.0 0.0 1.0))
;;; *   >>Block name/Color/Entity/Flag/LAyer/LType/Pick/Style/Thickness/Vector:
;;;
;;;   Wenn etwas schon in der Filter Liste existiert, und Sie etwas
;;;   neues dafuer waehlen, so wird der alte Wert durch den neuen
;;;   ueberschrieben. Denn Sie koennen nur jeweils einen einzigen Typ
;;;   in einem (ssget "x") Aufruf verwenden.
;;;
;;;--------------------------------------------------------------------------;
;;;
;;; Finde die Punkte-Paare {dottet pairs}, die gueltige Filter
;;; fuer ssget des Elementes nammens "ent".
;;;
;;; ssx_fe == SSX_Find_Entity
;;;
(defun ssx_fe (/ x data fltr ent)
  (setq ent (car (entsel "\nObjekte whlen/<Keines>: ")))
  (if ent
    (progn
      (setq data (entget ent))
      (foreach x '(0 2 6 7 8 39 62 66 210) ;; 38 ist ausgelassen
        (if (assoc x data)
          (setq fltr
            (cons (assoc x data) fltr)
          )
        )
      )
      (reverse fltr)
    )
  )
)
;;; Ein Element von der Liste "alist"
;;; Remove "element" from "alist".
;;;
;;; ssx_re == SSX_Remove_Element
;;;
(defun ssx_re (element alist)
  (append
    (reverse (cdr (member element (reverse alist))))
    (cdr (member element alist))
  )
)
;;; Interne Fehler Routine
;;; INTERNAL ERROR HANDLER
;;;
(defun ssx_er (s)                     ; Wenn ein Fehler ( z.B. CTRL-C)
                                      ; im Befehl auftritt....
  (if (/= s "Funktion abgebrochen")
    (princ (strcat "\nFehler: " s))
  )
  (if olderr (setq *error* olderr))   ; den alten " *error* handler"
  (princ)                             ; wiederherstellen.
)
;;;
;;; Uebernehme den gefilterten Auswahlsatz.
;;;
;;;
(defun ssx (/ olderr)
  (gc)                                ; alle Auswahlsaetze schliessen.
  (setq olderr *error*
        *error* ssx_er
  )
  (setq fltr (ssx_fe))
  (ssx_gf fltr)
)
;;;
;;; Die Filter Liste wird durch anpicken, Hinzufuegen , oder
;;; wegnehmen eines Elementes der Liste durch anwaehlelen
;;; gefolgt von "return"
;;;
;;; ssx_gf == SSX_Get_Filters
;;;
;;; * REM * nach initget " .. " noch zu uebersetzen
(defun ssx_gf (f1 / t1 t2 t3 f1 f2)
  (while
    (progn
      (cond (f1 (prompt "\nFilter: ") (prin1 f1)))
      (initget
        "Block FArbe Entity FLag LAyer LTyp Pick Stil Objekthhe Vektor")
      (setq t1 (getkword (strcat
        "\n>>Blockname/FArbe/Entity/FLag/"
        "LAyer/LTyp/Pick/Stil/Objekthhe/Vektor: ")))
    )
    (setq t2
      (cond
        ((eq t1 "Block")       2)   ((eq t1 "FArbe")     62)
        ((eq t1 "Entity")      0)   ((eq t1 "LAyer")      8)
        ((eq t1 "LTyp")        6)   ((eq t1 "Stil")       7)
        ((eq t1 "Objekthhe") 39)   ((eq t1 "FLag" )     66)
        ((eq t1 "Vektor")    210)
        (T t1)
      )
    )
    (setq t3
      (cond
        ((= t2  2)  (getstring "\n>>Blockname anhngen/<RETURN entfernen>: "))
        ((= t2 62)  (initget 4 "?")
          (cond
            ((or (eq (setq t3 (getint
              "\n>>Farbnummer anhngen/?/<RETURN entfernen>: ")) "?")
              (> t3 256))
              (ssx_pc)                ; Farbwerte drucken
              nil
            )
            (T
              t3                      ; gibt t3 zurueck.
            )
          )
        )
        ((= t2  0) (getstring "\n>>Entity Typ hinzufgen/<RETURN entfernen >: "))
        ((= t2  8) (getstring "\n>>Layer Name hinzufgen/<RETURN entfernen >: "))
        ((= t2  6) (getstring "\n>>Linentyp Name hinzufgen/<RETURN entfernen>: "))
        ((= t2  7)
          (getstring "\n>>Text Stil Name hinzufgen/<RETURN enttfernen>: ")
        )
        ((= t2 39)  (getreal   "\n>>Objekthhe hinzufuegen /<RETURN entfernen>: "))
        ((= t2 66)  (if (assoc 66 f1) nil 1))
        ((= t2 210)
          (getpoint  "\n>>Extrusionsvektor hinzufgen /<RETURN entfernen>: ")
        )
        (T          nil)
      )
    )
    (cond
      ((= t2 "Pick") (setq f1 (ssx_fe) t2 nil)) ; Element holen
      ((and f1 (assoc t2 f1))                   ; ist schon in Liste
        (if (and t3 (/= t3 ""))
          ;; durch neuem Wert ersetzen ...
          (setq f1 (subst (cons t2 t3) (assoc t2 f1) f1))
          ;; von der Filter Liste entfernen ..
          (setq f1 (ssx_re (assoc t2 f1) f1))
        )
      )
      ((and t3 (/= t3 ""))
        (setq f1 (cons (cons t2 t3) f1))
      )
      (T nil)
    )
  )
  (if f1 (setq f2 (ssget "x" f1)))
  (setq *error* olderr)
  (if (and f1 f2)
    (progn
      (princ (strcat "\n" (itoa (sslength f2)) " gefunden. "))
      f2
    )
    (progn (princ "\n0 gefunden.") (prin1))
  )
)
;;;
;;; Die standart Farb-Zuordnungen ausgeben.
;;;
;;;
(defun ssx_pc ()
  (if textpage (textpage) (textscr))
  (princ "\n                                                     ")
  (princ "\n                 Farb Nummer    |   Standard Werte   ")
  (princ "\n                ________________|____________________")
  (princ "\n                                |                    ")
  (princ "\n                       0        |      <BYBLOCK>     ")
  (princ "\n                       1        |      Rot           ")
  (princ "\n                       2        |      Gelb          ")
  (princ "\n                       3        |      Grn          ")
  (princ "\n                       4        |      Hellblau      ")
  (princ "\n                       5        |      Blau          ")
  (princ "\n                       6        |      Violett       ")
  (princ "\n                       7        |      White         ")
  (princ "\n                    8...255     |      -verschieden- ")
  (princ "\n                      256       |      <VONLAYER>    ")
  (princ "\n                                               \n\n\n")
)
;;;
;;; C: Funktions Definition
;;;
(defun c:ssx () (ssx)(princ))
(princ "\n\tTippen Sie \"ssx\" bei Befehl: oder")
(princ "\n\t(ssx) bei einer Objektauswahl. ")
(princ)
