neue Folder LAYOUT MENU und MODULE dazu

2025-04-14 16:56:58 +02:00
parent e6e1705f0d
commit 35f7b2d75e
935 changed files with 803964 additions and 0 deletions
@@ -0,0 +1,131 @@
+;............................................................
+;:      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)
+