131 lines
3.8 KiB
Common Lisp
131 lines
3.8 KiB
Common Lisp
;............................................................
|
|
;: 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 zuf�gen,
|
|
;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 " ")
|
|
) ;R�ckschalten
|
|
(IF (> (- blkl bpos) 0)
|
|
(GRTEXT (1+ mlen) "Next")
|
|
(GRTEXT (1+ mlen) " ")
|
|
) ;Vorw„rtsschalten
|
|
(IF (= (CAR (SETQ antw (GRREAD))) 4)
|
|
(IF (< (CADR antw) mlen)
|
|
;wenn g�ltige 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 Einf�gen
|
|
(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 einf�gen
|
|
)
|
|
(emsg "Field false!")
|
|
)
|
|
)
|
|
)
|
|
(GRTEXT)
|
|
;wiederherstellen des Seitenmenus
|
|
(pend)
|
|
)
|
|
(emsg "No blocks in the drawing")
|
|
)
|
|
(PRINC)
|
|
)
|
|
(PRINC)
|
|
(PRINC "\nBlockmanager loaded")
|
|
(PRINC)
|
|
|