225 lines
7.6 KiB
Common Lisp
225 lines
7.6 KiB
Common Lisp
;;; 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 w„hlen/<Keines>: (RETURN)
|
|
;;; * >>Blockname/FArbe/Entity/FLag/LAyer/LType/Pick/Stil/Objekth”he/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 w„hlen/<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 Objekth”he Vektor")
|
|
(setq t1 (getkword (strcat
|
|
"\n>>Blockname/FArbe/Entity/FLag/"
|
|
"LAyer/LTyp/Pick/Stil/Objekth”he/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 "Objekth”he") 39) ((eq t1 "FLag" ) 66)
|
|
((eq t1 "Vektor") 210)
|
|
(T t1)
|
|
)
|
|
)
|
|
(setq t3
|
|
(cond
|
|
((= t2 2) (getstring "\n>>Blockname anh„ngen/<RETURN entfernen>: "))
|
|
((= t2 62) (initget 4 "?")
|
|
(cond
|
|
((or (eq (setq t3 (getint
|
|
"\n>>Farbnummer anh„ngen/?/<RETURN entfernen>: ")) "?")
|
|
(> t3 256))
|
|
(ssx_pc) ; Farbwerte drucken
|
|
nil
|
|
)
|
|
(T
|
|
t3 ; gibt t3 zurueck.
|
|
)
|
|
)
|
|
)
|
|
((= t2 0) (getstring "\n>>Entity Typ hinzuf�gen/<RETURN entfernen >: "))
|
|
((= t2 8) (getstring "\n>>Layer Name hinzuf�gen/<RETURN entfernen >: "))
|
|
((= t2 6) (getstring "\n>>Linentyp Name hinzuf�gen/<RETURN entfernen>: "))
|
|
((= t2 7)
|
|
(getstring "\n>>Text Stil Name hinzuf�gen/<RETURN enttfernen>: ")
|
|
)
|
|
((= t2 39) (getreal "\n>>Objekth”he hinzufuegen /<RETURN entfernen>: "))
|
|
((= t2 66) (if (assoc 66 f1) nil 1))
|
|
((= t2 210)
|
|
(getpoint "\n>>Extrusionsvektor hinzuf�gen /<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 | Gr�n ")
|
|
(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)
|
|
|