;............................................................ ;: DATE : 92-01-01 Kunde: tewi : ;: Autor: Schmidt AutoCAD-Version 11 : ;: Version 2.0 ab Version 10 mit anpassen : ;: : ;: BLKM.LSP Block-Manager : ;:..........................................................: (SPECIAL '(bsca)) (DEFUN blis (/ blst blt blkt) (SETQ blst T) (WHILE (SETQ blt (TBLNEXT "BLOCK" blst)) ;solange noch Bl”cke vorhanden, ;speichern (IF (/= (ASCII (SETQ blkt (CDR (ASSOC 2 blt)))) 42) (SETQ blk (CONS blkt blk)) ) ;neuer Block der Liste zufgen, ;speichern (SETQ blst NIL) ) ) (DEFUN bdis (/ run lauf blkl) (SETQ run T lauf 0 blkl (LENGTH blk) ;L„nge der Liste ) (WHILE run (WHILE (< lauf mlen) (IF (< bpos blkl) (GRTEXT lauf (NTH bpos blk)) (GRTEXT lauf " ") ) ;Menuanzeige (SETQ lauf (1+ lauf) bpos (1+ bpos) ) ;um 1 erh”hen ) (IF (> bpos mlen) (GRTEXT mlen "Previous") (GRTEXT mlen " ") ) ;Rckschalten (IF (> (- blkl bpos) 0) (GRTEXT (1+ mlen) "Next") (GRTEXT (1+ mlen) " ") ) ;Vorw„rtsschalten (IF (= (CAR (SETQ antw (GRREAD))) 4) (IF (< (CADR antw) mlen) ;wenn gltige Antwort (SETQ run NIL antw (+ (CADR antw) (- bpos lauf)) bpos (- bpos mlen) ) (COND ((AND (= (CADR antw) mlen)(> bpos mlen)) ;Vorher (SETQ bpos (- bpos mlen mlen) lauf 0 ) ) ((AND (= (CADR antw) (1+ mlen))(> blkl bpos)) ;N„chst (SETQ lauf 0) ) (T (SETQ run NIL antw blkl bpos (- bpos mlen) ) ) ) ) (SETQ antw NIL run NIL blk NIL) ) ) ) (DEFUN C:blkm (/ blk); best bpos mlen antw) ;Bl”cke auflisten und Einfgen (SETQ lauf 0 ;Laufvariable initialisieren, bpos 0 ;Blocklaufvariable initialisieren, mlen 20 ;Menul„nge ) (blis) (IF blk (PROGN (IF (NULL bsca) (SETQ bsca 1.0) ) (pstart "Block Manager" "" nil) (SETQ blk (REVERSE blk) ;Liste kehren bsca (IF (SETQ best (GETREAL (STRCAT "\nGeneral scale <" (RTOS bsca) ">: ")) ) best bsca ) ) (GRREAD T) (WHILE blk (PRINC "\nSelect block from screen menu: ") (bdis) (IF antw ;wenn Antwort ok (IF (NTH antw blk) (PROGN (PROMPT "\nInput insert point and angle: ") (COMMAND "_insert" (NTH antw blk) PAUSE bsca bsca Pause) ;angepickter Block einfgen ) (emsg "Field false!") ) ) ) (GRTEXT) ;wiederherstellen des Seitenmenus (pend) ) (emsg "No blocks in the drawing") ) (PRINC) ) (PRINC) (PRINC "\nBlockmanager loaded") (PRINC)