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,119 @@
+;---------- Erstellung von S„ulenraster f�r Lagerbl”cke --------------
+; 24.3.93 AW
+;---------------------------------------------------------------------
+
+
+
+(DEFUN c:saeule (/ p0 l b rl rb fk1 fk2 art typ etage sl_sym ebene)
+  ;------------------------------------------------------------------
+  ; p0     - linke-untere Ecke
+  ; l      - L„nge des Bereiches
+  ; b      - Breite des Bereiches
+  ; rl     - L„nge des S„ulenrasters
+  ; rb     - Breite des S„ulenrasters
+  ; fk1    - f�r die Optimierung, dann Anzahl SPALTEN
+  ; fk2    - f�r die Optimierung, dann Anzahl ZEILEN
+  ; art    - S„ulenart - (P)rofil/(S)tahl
+  ; typ    - nur f�r Stahl: 1-4.3x3/2-5x3/3-5x5/4-4.8x4.8
+  ; etage  - S„ulenh”he
+  ; sl_sym - Symbolname
+  ; ebene  - "P-8" f�r Profil / "S-8" f�r Stahl
+  ;--------------------------------------------------------------------
+
+  (SETVAR "limcheck" 0)
+  (PROMPT "*************** SŽULENRASTER **********************")
+  (PROMPT "")
+  ;<<<Abfrageteil>>>
+  (INITGET (+ 2 4))
+  (SETQ p0 (GETPOINT "\nUntere-linke Ecke des Bereiches antippen: "))
+  (SETQ l  (GETREAL "\nLŽNGE der verf�gbaren Fl„che: "))
+  (SETQ b  (GETREAL "\nBREITE der verf�gbaren Fl„che: "))
+  (SETQ rl (GETREAL  "\nS„ulenraster-> LŽNGE <5000>: "))
+  (IF
+	(= nil rl)
+	(SETQ rl 5000)
+  )
+  (SETQ rb (GETREAL  "\nS„ulenraster-> BREITE <3000>: "))
+  (IF
+	(= nil rb)
+	(SETQ rb 3000)
+  )
+
+  ;--------------------------------------------------------------------------
+  ;<<<< Abfrage der S„ulenart / Etagen und Name der Symbole definieren >>>>
+  ;--------------------------------------------------------------------------
+  (INITGET 1 "P S  ")
+  (SETQ art (STRCASE (SUBSTR (GETKWORD "Profil/<Stahl>: ") 1 1)))
+  (IF
+	(= nil art)
+	(SETQ art "S")
+  )
+  (INITGET (+ 2 4))
+  (SETQ etage (GETINT "\nAnzahl Ebenen <1>: "))
+  (IF
+	(= nil etage)
+	(SETQ etage 1)
+  )
+  (SETQ typ   (GETINT "\nTyp: (1) 4.3x3 (2) 5x3 (3) 5x5 (4) 4.8x4.8 <2>: "))
+  (IF
+	(= nil typ)
+	(SETQ typ 2)
+  )
+
+  (Cond
+    ((Or (= art "S") (= art ""))            ; Stahlger�st
+      (SETQ ebene "S-8")
+      (Cond
+      )
+    )
+    ((= art "P")                             ; Profilger�st
+      (SETQ ebene "P-8")
+      (Cond
+      )
+    )
+  )
+  ;-----------------------------------
+  ;<<<Berechnung und Optimierung >>>>
+  ;-----------------------------------
+  ; L„nge und Breite konform dem S„ulenraster optimieren
+  (SETQ fk1 (/ l rl) fk2 (FIX (/ l rl)))
+  (IF
+	(> (- fk1 fk2) 0)
+	(SETQ l (* (+ fk2 1) rl))
+  )
+  (SETQ fk1 (/ b rb) fk2 (FIX (/ b rb)))
+  (IF
+	(> (- fk1 fk2) 0)
+	(SETQ b (* (+ fk2 1) rb))
+  )
+  ; Anzahl SPALTEN und ZEILEN definieren
+  (SETQ fk1 (+ 1 (/ l rl)) fk2 (+ 1 (/ b rb)))
+
+  ;---------------------------------------------
+  ;<<<Punkte definieren
+  ;---------------------------------------------
+  (SETQ p1 (LIST (car p0) (- (cadr p0) 500))
+        p2 (LIST (car p0) (+ (cadr p0) (+ b 500)))
+        p3 (LIST (- (car p0) 500) (cadr p0))
+        p4 (LIST (+ (car p0) (+ l 500)) (cadr p0))
+  )
+
+  ;---------------------------------------------
+  ;<<<S„ulenraster zeichnen
+  ;---------------------------------------------
+
+  (COMMAND "_layer" "_m" ebene "_c" "8" "" "")
+  (COMMAND "_line" p1 p2 "")
+  (COMMAND "_line" p3 p4 "")
+  
+  (IF (> fk1 1)  ; SPALTEN
+	(command "_array" p1 "" "r" "1" (FIX fk1) rl)
+  )
+  (IF (> fk2 1)  ; ZEILEN
+	(command "_array" p3 "" "r" (FIX fk2) "1" rb)
+  )
+
+)  ;------------ ENDE S„ulenraster ---------------
+
+
+