From a3011e7c2ae032f9129054f402998c51feb6b6ed Mon Sep 17 00:00:00 2001 From: Michael Stangl Date: Fri, 8 May 2026 11:19:36 +0200 Subject: [PATCH] Aus den Lisp Daten unter M:\ACADSST\MENU eine neue Standardlibrary mit Codedoku extrahiert --- Lisp/README.md | 135 ++++ Lisp/ssg_core.lsp | 363 +++++++++++ Lisp/ssg_dialog.lsp | 165 +++++ Lisp/ssg_layer.lsp | 315 ++++++++++ Lisp/ssg_load.lsp | 30 + doc/acadsst/HFS/hfs_mod.lsp | 104 +++ doc/acadsst/ILS2100/ils_ae_elem.lsp | 181 ++++++ doc/acadsst/ILS2100/ils_anbau_str.lsp | 243 +++++++ doc/acadsst/ILS2100/ils_angebot.lsp | 383 +++++++++++ doc/acadsst/ILS2100/ils_angebot_module.lsp | 175 ++++++ doc/acadsst/ILS2100/ils_sensor.lsp | 94 +++ doc/acadsst/ILS2100/ils_verb_str.lsp | 107 ++++ doc/acadsst/MENU/laymr14.lsp | 462 ++++++++++++++ doc/acadsst/MENU/ssg.lsp | 518 +++++++++++++++ doc/acadsst/MENU/ssg_110617.lsp | 515 +++++++++++++++ doc/acadsst/MENU/ssg_130829.lsp | 518 +++++++++++++++ doc/acadsst/MENU/ssg_old.lsp | 434 +++++++++++++ doc/acadsst/Spinnerei/alt/pu1pu2.lsp | 697 +++++++++++++++++++++ doc/acadsst_uebersicht.md | 70 +++ 19 files changed, 5509 insertions(+) create mode 100644 Lisp/README.md create mode 100644 Lisp/ssg_core.lsp create mode 100644 Lisp/ssg_dialog.lsp create mode 100644 Lisp/ssg_layer.lsp create mode 100644 Lisp/ssg_load.lsp create mode 100644 doc/acadsst/HFS/hfs_mod.lsp create mode 100644 doc/acadsst/ILS2100/ils_ae_elem.lsp create mode 100644 doc/acadsst/ILS2100/ils_anbau_str.lsp create mode 100644 doc/acadsst/ILS2100/ils_angebot.lsp create mode 100644 doc/acadsst/ILS2100/ils_angebot_module.lsp create mode 100644 doc/acadsst/ILS2100/ils_sensor.lsp create mode 100644 doc/acadsst/ILS2100/ils_verb_str.lsp create mode 100644 doc/acadsst/MENU/laymr14.lsp create mode 100644 doc/acadsst/MENU/ssg.lsp create mode 100644 doc/acadsst/MENU/ssg_110617.lsp create mode 100644 doc/acadsst/MENU/ssg_130829.lsp create mode 100644 doc/acadsst/MENU/ssg_old.lsp create mode 100644 doc/acadsst/Spinnerei/alt/pu1pu2.lsp create mode 100644 doc/acadsst_uebersicht.md diff --git a/Lisp/README.md b/Lisp/README.md new file mode 100644 index 0000000..44ed610 --- /dev/null +++ b/Lisp/README.md @@ -0,0 +1,135 @@ +# Lisp – AutoLISP-Standardbibliotheken + +Allgemeingültige AutoLISP-Routinen für AutoCAD, destilliert aus den historischen ACADSST-Makros (Schönenberger Systeme GmbH). Die drei `ssg_`-Bibliotheken sind projektunabhängig einsetzbar. + +--- + +## Ladereihenfolge + +```lisp +(load "pfad/ssg_load.lsp") ; lädt core → dialog → layer +``` + +Oder einzeln (Abhängigkeit beachten: `ssg_dialog` und `ssg_layer` setzen `ssg_core` voraus): + +```lisp +(load "pfad/ssg_core.lsp") +(load "pfad/ssg_dialog.lsp") +(load "pfad/ssg_layer.lsp") +``` + +--- + +## Dateien + +### `ssg_core.lsp` – Kernbibliothek + +Grundfunktionen für Umgebungssicherung, Benutzerinteraktion, Layer, Blöcke und Attribute. + +| Funktion | Beschreibung | +|---|---| +| `ssg-start titel vars` | Systemvariablen sichern, CMDECHO aus, Undo-Gruppe öffnen | +| `ssg-end` | Systemvariablen wiederherstellen, Undo-Gruppe schließen | +| `ssg-errhan em` | Fehlerhandler – räumt auf und ruft `ssg-end` auf | +| `ssg-ques text defa` | Ja/Nein-Abfrage; `defa=T` → Default Ja, `nil` → Default Nein | +| `ssg-emsg text` | Fehlermeldung mit optionalem Signalton (`ssg-bell`) | +| `ssg-get-layer text` | Layer eines angeklickten Objektes ermitteln | +| `ssg-layer-ss name typ` | Auswahlsatz aller Objekte eines Layers (optional nach Typ filtern) | +| `ssg-make-layer name farbe aktiv` | Layer anlegen (falls nicht vorhanden) und optional aktivieren | +| `ssg-ss-foreach ss func` | Iteration über Auswahlsatz – `func` wird für jeden Entity-Name aufgerufen | +| `ssg-ss-redraw ss modus` | Alle Elemente eines Auswahlsatzes hervorheben (3), invertieren (4) oder normal (0) | +| `ssg-ss-add src dest` | Auswahlsatz `src` zu `dest` hinzufügen (in-place, mit Highlight) | +| `ssg-make-blockname pt` | Eindeutigen Blocknamen aus Einfügepunkt + Zeitstempel erzeugen | +| `ssg-insert-block layer farbe pfad pt xs ys rot` | Layer anlegen und Block einfügen | +| `ssg-make-block pt rotation ss` | Auswahlsatz als Block definieren und gleich einfügen; Name aus `ssg-make-blockname` | +| `ssg-attrib-set tag wert ersetzen` | Ein Attribut der letzten Einfügung setzen oder anfügen | +| `ssg-attrib-set-many alist` | Mehrere Attribute auf einmal setzen (`'(("TAG" . "Wert") ...)`) | +| `ssg-attrib-by-handle handle tag wert ersetzen` | Attribut eines Blocks anhand seines Entity-Handles suchen und ändern | +| `ssg-dialog-run dcl id init-fn accept-fn` | Generischer DCL-Dialog: laden, initialisieren, starten, entladen | +| `ssg-zoom-save` | Aktuelle View-Größe merken | +| `ssg-zoom-restore` | Auf gemerkte View-Größe zurückschalten (nur wenn verändert) | + +--- + +### `ssg_dialog.lsp` – Dialog-Pattern für Modul-Einfüge-Makros + +Kapselt das wiederkehrende DCL-Muster: Dialog mit Vorschaubild, Radio-Auswahl, Block einfügen, Attribute setzen. + +| Funktion | Beschreibung | +|---|---| +| `ssg-dia-show-slide tile lib name` | Vorschau-Slide im image-Tile aktualisieren (Bibliothek + Slide-Name) | +| `ssg-dia-update-preview tile idx lib liste` | Vorschau anhand Index-String aus Radio-/List-Tile aktualisieren | +| `ssg-modul-dialog dcl id sel-tile start-val prev-tile lib slides extra-init extra-read` | Vollständiger Modul-Dialog: lädt DCL, setzt Tiles, verknüpft Vorschau, liefert gewählten Index zurück | +| `ssg-insert-modul layer farbe pfad attribs rotation` | Standardsequenz: Layer anlegen → Punkt abfragen → Block einfügen → Attribute setzen | + +Die Datei enthält außerdem ein auskommentiertes **Template** für neue `c:BEFEHL`-Definitionen nach dem SSG-Muster. + +--- + +### `ssg_layer.lsp` – Interaktive Layer-Verwaltung + +Benutzerfreundliche AutoCAD-Befehle für Layer-Operationen. Alle Befehle sichern die Umgebung über `ssg-start`/`ssg-end`. + +**Hilfsfunktionen (intern):** + +| Funktion | Beschreibung | +|---|---| +| `ssg-layer-list-all` | Alle Layernamen als Liste | +| `ssg-layer-info-all` | Alle Layer als Assoziationslisten (Name, Farbe, Linientyp, Flags) | +| `ssg-layer-visible-p name` | Sichtbarkeitsstatus prüfen (T = sichtbar) | +| `ssg-layer-safe-p name gruppe` | Prüfen ob Layer ausgeschaltet werden darf (nicht aktiver Layer) | +| `ssg-layer-group name` | Gruppen-Kennung aus Layernahme extrahieren (Position 2–3) | +| `ssg-layer-rename-group name neu` | Neuen Layernamen mit geänderter Gruppen-Kennung berechnen | +| `ssg-layer-group-move alt neu` | Alle Objekte einer Layergruppe auf neue Gruppen-Kennung verschieben | + +**AutoCAD-Befehle:** + +| Befehl | Beschreibung | +|---|---| +| `c:SSG-LayerSet` | Layer des angeklickten Objektes als aktiven Layer setzen | +| `c:SSG-LayerInfo` | Layer des angeklickten Objektes anzeigen | +| `c:SSG-LayerMove` | Auswahlsatz auf Layer eines anderen Objektes verschieben | +| `c:SSG-LayerCopy` | Auswahlsatz kopieren und Kopie auf Ziel-Layer legen | +| `c:SSG-LayerMoveType` | Alle Objekte des gleichen Typs auf dem gleichen Layer verschieben | +| `c:SSG-LayerOff` | Layer durch Anklicken ausschalten (Schleife bis Enter) | +| `c:SSG-LayerFreeze` | Layer durch Anklicken einfrieren (Schleife bis Enter) | +| `c:SSG-FreezeAll` | Alle Layer außer einem einfrieren | +| `c:SSG-ThawAll` | Alle Layer auftauen | +| `c:SSG-LayerOnAll` | Alle ausgeschalteten Layer einschalten | +| `c:SSG-LayerDelete` | Layer mit Sicherheitsabfrage löschen (Objekte + Layer) | + +--- + +### `ssg_load.lsp` – Laderoutine + +Lädt alle drei Bibliotheken in der richtigen Reihenfolge. Ermittelt den Pfad automatisch über `findfile`. + +--- + +### `SSG_LIB_Commands.lsp` – Dummy-Befehle für das SSG-Menü + +Platzhalter-Definitionen für alle Menüeinträge des SSG-Menüsystems (ILS-Module, Kurven, Gefällestrecken). Gibt beim Aufruf eine Meldung aus. Wird durch echte Implementierungen ersetzt sobald die jeweiligen Blöcke und DCL-Dialoge vorliegen. + +--- + +### `ILSModulInsert.lsp` – ILS Kreisel-Modul-Einfügung + +Einfügen von ILS-Kreisel-Modulen mit Abstand- und Typ-Konfiguration (mit/ohne PIN). Enthält Smart-Connect-Logik für automatische Positionierung. Befehl: `c:KreiselInsert`. + +--- + +### `OmniModulInsert.lsp` – Omni-Modul-Einfügung + +Einfügen von Omni-Modulen. Befehl analog zu `ILSModulInsert`. + +--- + +### `VarioFoerderer.lsp` – Vario-Förderer + +Umfangreiche Routinen für den Vario-Förderer (Strecken, Kurven, Sonderelemente). Größte Einzeldatei im Projekt. + +--- + +### `tests.lsp` – Testskript + +Manuelle Tests für die Bibliotheksfunktionen. Nicht für den Produktiveinsatz laden. diff --git a/Lisp/ssg_core.lsp b/Lisp/ssg_core.lsp new file mode 100644 index 0000000..d681180 --- /dev/null +++ b/Lisp/ssg_core.lsp @@ -0,0 +1,363 @@ +;; ============================================================ +;; SSG_CORE.LSP - Kernbibliothek: Umgebung, Fehler, Dialog +;; Allgemeingueltige Hilfsfunktionen fuer AutoCAD-LISP Makros +;; Ursprung: ACADSST/MENU/ssg.lsp, pu1pu2.lsp (Schoenenberger) +;; Bereinigt und verallgemeinert: 2025 +;; ============================================================ + + +;; ------------------------------------------------------------ +;; UMGEBUNGSSICHERUNG +;; Sichert Systemvariablen vor Makroausfuehrung und stellt +;; sie danach wieder her. Wird immer als Paar verwendet: +;; (ssg-start "Titel" '(("OSMODE") ("ORTHOMODE"))) +;; ... Makrocode ... +;; (ssg-end) +;; ------------------------------------------------------------ + +(defun ssg-start (titel zusatz-vars / xlen xpos xvar) + ;; titel - Anzeigename des Makros + ;; zusatz-vars - Liste zusaetzlicher Variablen z.B. '(("OSMODE")("ORTHOMODE")) + ;; Immer CLAYER und CMDECHO werden automatisch gesichert. + (setq _ssg-olderr *error* + *error* (function ssg-errhan) + _ssg-cavar (append '(("CLAYER") ("CMDECHO")) zusatz-vars) + xlen (length _ssg-cavar) + xpos 0 + ) + (repeat xlen + (setq xvar (car (nth xpos _ssg-cavar)) + _ssg-cavar (subst (cons xvar (getvar xvar)) + (nth xpos _ssg-cavar) _ssg-cavar) + xpos (1+ xpos) + ) + ) + (setvar "CMDECHO" 0) + (command "_undo" "_G") + (graphscr) + (if titel (prompt (strcat "\n***** " titel " *****\n"))) + (princ) +) + +(defun ssg-end (/ xpos xlen xvar) + (if _ssg-cavar + (progn + (command) + (command "_undo" "_E") + (setq xpos 1 + xlen (length _ssg-cavar) + ) + (if (/= (getvar "CLAYER") (caar _ssg-cavar)) + (command "_LAYER" "_SE" (cdar _ssg-cavar) "") + ) + (repeat (1- xlen) + (setq xvar (nth xpos _ssg-cavar) + xpos (1+ xpos) + ) + (setvar (car xvar) (cdr xvar)) + ) + ) + ) + (if _ssg-olderr (setq *error* _ssg-olderr)) + (princ) +) + +(defun ssg-errhan (em) + (if (= em "Function cancelled") + (princ) + (progn (princ "\nFehler: ") (princ em)) + ) + (command) + (command) + (ssg-end) +) + + +;; ------------------------------------------------------------ +;; BENUTZER-ABFRAGEN +;; ------------------------------------------------------------ + +;; Ja/Nein-Abfrage mit konfigurierbarem Default +;; defa = T -> Default ist "Yes" (Eingabe noetig um "No" zu waehlen) +;; defa = nil -> Default ist "No" +;; Rueckgabe: T wenn "No" gewaehlt (also Ablehnung), nil wenn "Yes" +(defun ssg-ques (prompt-text defa) + (if defa + (progn + (initget 1 "Yes No Yes") + (= (getkword (strcat "\n" prompt-text " Y/N : ")) "No") + ) + (progn + (initget 1 "Yes No No") + (= (getkword (strcat "\n" prompt-text " Y/N : ")) "Yes") + ) + ) +) + +;; Fehlermeldung mit optionalem Signalton +;; ssg-bell = T -> kein Ton; nil -> Ton ausgeben +(defun ssg-emsg (text) + (if (not ssg-bell) (prompt "\007")) + (terpri) + (prompt text) + (terpri) +) + + +;; ------------------------------------------------------------ +;; LAYER-HILFSFUNKTIONEN +;; ------------------------------------------------------------ + +;; Layer eines angeklickten Objektes ermitteln +;; txt = Prompt-Text fuer Objektauswahl +;; Rueckgabe: Layername als String, nil wenn Abbruch +(defun ssg-get-layer (txt / sel) + (if (setq sel (entsel txt)) + (cdr (assoc 8 (entget (car sel)))) + ) +) + +;; Alle Objekte eines bestimmten Layers als Auswahlsatz liefern +;; lay-name = Layername; ent-typ = Entitaetstyp z.B. "LINE" (nil = alle) +(defun ssg-layer-ss (lay-name ent-typ) + (if ent-typ + (ssget "X" (list (cons 0 ent-typ) (cons 8 lay-name))) + (ssget "X" (list (cons 8 lay-name))) + ) +) + +;; Layer anlegen (falls nicht vorhanden) und optional setzen +;; lay-name = Name; color = Farbnummer als String z.B. "2"; set-aktiv = T/nil +(defun ssg-make-layer (lay-name color set-aktiv) + (if set-aktiv + (command "_LAYER" "_M" lay-name "_CO" color lay-name "") + (command "_LAYER" "_N" lay-name "_CO" color lay-name "") + ) +) + +;; Auswahlsatz-Iteration: Funktion fuer jedes Element aufrufen +;; ss = Auswahlsatz; func = Funktion mit einem Parameter (entity-name) +(defun ssg-ss-foreach (ss func / i ename) + (if ss + (progn + (setq i 0) + (while (setq ename (ssname ss i)) + (func ename) + (setq i (1+ i)) + ) + ) + ) +) + +;; Alle Elemente eines Auswahlsatzes hervorheben/zuruecksetzen +;; ss = Auswahlsatz; modus = 3 (hervorheben) / 4 (invertiert) / 0 (normal) +(defun ssg-ss-redraw (ss modus / i ename) + (if ss + (progn + (setq i 0) + (while (setq ename (ssname ss i)) + (redraw ename modus) + (setq i (1+ i)) + ) + ) + ) +) + +;; Auswahlsatz zu einem anderen Auswahlsatz hinzufuegen (in-place) +;; src-ss = Quell-Auswahlsatz; dest-ss = Ziel-Auswahlsatz (wird modifiziert) +(defun ssg-ss-add (src-ss dest-ss / i ename) + (if (null dest-ss) (setq dest-ss (ssadd))) + (setq i 0) + (while (setq ename (ssname src-ss i)) + (ssadd ename dest-ss) + (redraw ename 3) + (setq i (1+ i)) + ) + dest-ss +) + + +;; ------------------------------------------------------------ +;; BLOCK-OPERATIONEN +;; ------------------------------------------------------------ + +;; Eindeutigen Blocknamen aus Einfuegepunkt + Zeitstempel erzeugen +;; pt = Einfuegepunkt (Liste); Rueckgabe: Blockname als String +(defun ssg-make-blockname (pt / k1 k2) + (setq k1 (strcat (itoa (abs (fix (car pt)))) + (itoa (abs (fix (cadr pt)))) + (itoa (abs (fix (caddr pt))))) + k2 (substr (rtos (getvar "cdate") 2 9) 10 9) + ) + (strcat k1 k2) +) + +;; Einzel-Block einfuegen mit Layer anlegen +;; lay-name = Ziel-Layer; color = Layerfarbe +;; blk-pfad = vollstaendiger Blockpfad (ohne Erweiterung) +;; pt = Einfuegepunkt; xscale yscale = Skalierung ("" = 1) +;; rotation = Drehwinkel als String oder pause fuer interaktiv +(defun ssg-insert-block (lay-name color blk-pfad pt xscale yscale rotation) + (ssg-make-layer lay-name color T) + (command "_insert" blk-pfad pt xscale yscale rotation) +) + +;; Block aus Auswahlsatz erstellen und gleich wieder einfuegen +;; pt = Origin; rotation = Drehwinkel als String +;; ss = Auswahlsatz der Elemente +;; Rueckgabe: Blockname (String) +(defun ssg-make-block (pt rotation ss / bname gefunden) + (setq bname (ssg-make-blockname pt) + gefunden (tblsearch "block" bname) + ) + (if (not gefunden) + (progn + (command "_block" bname pt ss "") + (command "_insert" bname pt "" "" rotation) + ) + (progn + (alert (strcat "Blockname '" bname "' existiert bereits - wird uebersprungen.")) + (setq bname (strcat "x" bname)) + (command "_block" bname pt ss "") + (command "_insert" bname pt "" "" rotation) + ) + ) + bname +) + + +;; ------------------------------------------------------------ +;; ATTRIBUT-OPERATIONEN +;; ------------------------------------------------------------ + +;; Attribut eines Blocks (letzte Einfuegung) aendern +;; tag = Attributbezeichner (z.B. "ARTINR") +;; wert = neuer Wert +;; ersetzen = T -> vollstaendiger Ersatz; nil -> Anfuegen +(defun ssg-attrib-set (tag wert ersetzen / obj typ attr-tag attr-wert) + (setq obj (entlast)) + (while (not (equal (cdr (assoc 0 (entget obj))) "SEQEND")) + (setq typ (cdr (assoc 0 (entget obj)))) + (if (equal typ "ATTRIB") + (progn + (setq attr-tag (cdr (assoc 2 (entget obj))) + attr-wert (cdr (assoc 1 (entget obj))) + ) + (if (equal attr-tag tag) + (if ersetzen + (entmod (subst (cons 1 wert) + (assoc 1 (entget obj)) (entget obj))) + (entmod (subst (cons 1 (strcat attr-wert wert)) + (assoc 1 (entget obj)) (entget obj))) + ) + ) + ) + ) + (setq obj (entnext obj)) + ) +) + +;; Mehrere Attribute eines Blocks auf einmal setzen +;; attrib-alist = Assoziationsliste '(("TAG1" . "Wert1") ("TAG2" . "Wert2") ...) +(defun ssg-attrib-set-many (attrib-alist / obj typ tag wert) + (setq obj (entlast)) + (while (not (equal (cdr (assoc 0 (entget obj))) "SEQEND")) + (setq typ (cdr (assoc 0 (entget obj)))) + (if (equal typ "ATTRIB") + (progn + (setq tag (cdr (assoc 2 (entget obj)))) + (setq wert (cdr (assoc tag attrib-alist))) + (if (and wert (> (strlen wert) 0)) + (entmod (subst (cons 1 wert) + (assoc 1 (entget obj)) (entget obj))) + ) + ) + ) + (setq obj (entnext obj)) + ) +) + +;; Attribut eines Blocks anhand seines Handle suchen und aendern +;; handle = Entity-Handle (String) des INSERT +;; tag = Attributbezeichner +;; wert = neuer Wert +;; ersetzen = T -> ersetzen; nil -> anhaengen +(defun ssg-attrib-by-handle (handle tag wert ersetzen / e typ blk-tag blk-wert fertig) + (setq e (entnext) + fertig nil + ) + (while (and e (not fertig)) + (setq typ (cdr (assoc 0 (entget e)))) + (if (and (equal (cdr (assoc 5 (entget e))) handle) + (equal typ "INSERT") + (equal (cdr (assoc 66 (entget e))) 1) + ) + (progn + (while (not (= (cdr (assoc 0 (entget e))) "SEQEND")) + (if (equal (cdr (assoc 0 (entget e))) "ATTRIB") + (progn + (setq blk-tag (cdr (assoc 2 (entget e))) + blk-wert (cdr (assoc 1 (entget e))) + ) + (if (equal blk-tag tag) + (if ersetzen + (entmod (subst (cons 1 wert) + (assoc 1 (entget e)) (entget e))) + (entmod (subst (cons 1 (strcat blk-wert wert)) + (assoc 1 (entget e)) (entget e))) + ) + ) + ) + ) + (setq e (entnext e)) + ) + (setq fertig T) + ) + ) + (setq e (entnext e)) + ) +) + + +;; ------------------------------------------------------------ +;; DIALOG-STANDARD-PATTERN +;; Vorlage fuer DCL-Dialoge: laden, initialisieren, starten +;; Verwendung: +;; (ssg-dialog-run "pfad/dialog.dcl" "dialog-name" init-fn accept-fn) +;; +;; init-fn = Funktion ohne Parameter, setzt Tiles und Actions +;; accept-fn = Funktion ohne Parameter, liest Tiles aus +;; ------------------------------------------------------------ + +(defun ssg-dialog-run (dcl-pfad dialog-name init-fn accept-fn / dat) + (setq dat (load_dialog dcl-pfad)) + (if (not (new_dialog dialog-name dat)) + (progn (alert "Dialog konnte nicht geladen werden.") (exit)) + ) + (if init-fn (init-fn)) + (action_tile "accept" "(if accept-fn (accept-fn)) (done_dialog 1)") + (action_tile "cancel" "(done_dialog 0)") + (start_dialog) + (unload_dialog dat) +) + + +;; ------------------------------------------------------------ +;; ZOOM-HILFSFUNKTIONEN +;; ------------------------------------------------------------ + +;; Aktuelle View-Groesse merken +(defun ssg-zoom-save () + (setq _ssg-view-size (getvar "VIEWSIZE")) +) + +;; Auf gespeicherte View-Groesse zurueckschalten (wenn veraendert) +(defun ssg-zoom-restore () + (if (and _ssg-view-size (/= (getvar "VIEWSIZE") _ssg-view-size)) + (command "_ZOOM" "_P") + ) +) + + +(prompt "\nssg_core.lsp geladen.") +(princ) diff --git a/Lisp/ssg_dialog.lsp b/Lisp/ssg_dialog.lsp new file mode 100644 index 0000000..f85426c --- /dev/null +++ b/Lisp/ssg_dialog.lsp @@ -0,0 +1,165 @@ +;; ============================================================ +;; SSG_DIALOG.LSP - Standard-Pattern fuer Modul-Einfuege-Dialoge +;; Kapselt das wiederkehrende Muster aus den ACADSST-Makros: +;; - DCL-Dialog mit Vorschaubild +;; - Radio-/List-Auswahl -> Blockname + Parameter setzen +;; - Block einfuegen + Attribute befuellen +;; +;; Setzt ssg_core.lsp voraus. +;; Ursprung: ILS2100/*.lsp, HFS/hfs_mod.lsp (Schoenenberger) +;; Bereinigt und verallgemeinert: 2025 +;; ============================================================ + + +;; ------------------------------------------------------------ +;; VORSCHAU-BILD im Dialog aktualisieren +;; tile-name = Name des image-Tiles im DCL (z.B. "anzeige") +;; slide-lib = Pfad zur .slb-Datei ohne Erweiterung (z.B. "m:/acadsst/ils2100") +;; slide-name = Name des Slides in der Bibliothek +;; Hintergrundfarbe -18 = AutoCAD-Grafik-Hintergrund +;; ------------------------------------------------------------ +(defun ssg-dia-show-slide (tile-name slide-lib slide-name / breite hoehe) + (setq breite (dimx_tile tile-name) + hoehe (dimy_tile tile-name) + ) + (start_image tile-name) + (fill_image 0 0 breite hoehe -18) + (slide_image 0 0 breite hoehe (strcat slide-lib "(" slide-name ")")) + (end_image) +) + +;; Vorschau mit Index-basierter Auswahl aktualisieren +;; tile-name = image-Tile-Name +;; idx-str = aktueller Auswahlindex als String (wie get_tile liefert) +;; slide-lib = Pfad zur Slide-Bibliothek +;; slide-list = Liste der Slide-Namen, Index entspricht dem Radio-Index +(defun ssg-dia-update-preview (tile-name idx-str slide-lib slide-list / idx) + (setq idx (atoi idx-str)) + (if (and (>= idx 0) (< idx (length slide-list))) + (ssg-dia-show-slide tile-name slide-lib (nth idx slide-list)) + ) +) + + +;; ------------------------------------------------------------ +;; GENERISCHER MODUL-DIALOG +;; Vereinfacht das haeufige Muster: +;; 1. DCL laden, Tiles initialisieren +;; 2. ACTION_TILE fuer Auswahl-Tile (aktualisiert Vorschau) +;; 3. accept/cancel +;; 4. Rueckgabe: ausgewaehlter Index oder nil bei Abbruch +;; +;; dcl-pfad = vollstaendiger Pfad zur .dcl-Datei +;; dialog-id = Name des Dialogs in der .dcl +;; select-tile= Name des List/Radio-Tiles fuer die Auswahl +;; start-val = Start-Auswahl als String (z.B. "0") +;; preview-tile= Name des image-Tiles (nil = kein Vorschaubild) +;; slide-lib = Pfad der Slide-Bibliothek (nil = kein Vorschaubild) +;; slide-list = Liste der Slide-Namen entsprechend Auswahl-Index +;; extra-init = Funktion fuer weitere Tile-Initialisierungen (nil = keine) +;; extra-read = Funktion zum Auslesen weiterer Tiles bei accept (nil = keine) +;; ------------------------------------------------------------ +(defun ssg-modul-dialog (dcl-pfad dialog-id select-tile start-val + preview-tile slide-lib slide-list + extra-init extra-read + / dat ergebnis aktuell) + (setq dat (load_dialog dcl-pfad) + aktuell start-val + ) + (if (not (new_dialog dialog-id dat)) + (progn (alert "Dialog nicht verfuegbar.") (exit)) + ) + (set_tile select-tile start-val) + (if (and preview-tile slide-lib slide-list) + (ssg-dia-update-preview preview-tile start-val slide-lib slide-list) + ) + (if extra-init (extra-init)) + (action_tile select-tile + (strcat + "(setq aktuell (get_tile \"" select-tile "\"))" + (if (and preview-tile slide-lib slide-list) + (strcat "(ssg-dia-update-preview \"" preview-tile "\" aktuell \"" + slide-lib "\" slide-list)") + "" + ) + ) + ) + (action_tile "accept" + (strcat + "(setq ergebnis aktuell)" + (if extra-read "(extra-read)" "") + "(done_dialog 1)" + ) + ) + (action_tile "cancel" "(done_dialog 0)") + (start_dialog) + (unload_dialog dat) + ergebnis +) + + +;; ------------------------------------------------------------ +;; BLOCK-MODUL EINFUEGEN - Standardsequenz +;; Kapselt das immer gleiche Muster: +;; 1. Layer anlegen +;; 2. Einfuegepunkt abfragen +;; 3. Block-Kennung (eindeutiger Name) erstellen +;; 4. Block einfuegen (mit Winkel-Abfrage oder fest) +;; 5. Attribute setzen +;; +;; lay-name = Ziel-Layer +;; lay-color = Layerfarbe als String +;; blk-pfad = vollstaendiger Blockpfad (Laufwerk + Verzeichnis + Dateiname) +;; attrib-alist= Assoziationsliste der Attribute '(("TAG" . "Wert") ...) +;; rotation = Drehwinkel als String oder pause fuer Benutzerabfrage +;; Rueckgabe = Einfuegepunkt +;; ------------------------------------------------------------ +(defun ssg-insert-modul (lay-name lay-color blk-pfad attrib-alist rotation / pt) + (ssg-make-layer lay-name lay-color T) + (setq pt (getpoint "\nEinfuegepunkt waehlen: ")) + (command "_insert" blk-pfad pt "" "" rotation) + (if attrib-alist + (ssg-attrib-set-many attrib-alist) + ) + pt +) + + +;; ------------------------------------------------------------ +;; HAUPT-MAKRO TEMPLATE +;; Vorlage fuer c:BEFEHL-Definitionen nach dem SSG-Muster. +;; Kopieren und anpassen. +;; +;; Beispiel-Aufruf eines konkreten Moduls (nicht ausfuehren): +;; +;; (defun c:MEIN_MODUL ( / pt ergebnis) +;; (ssg-start "MEIN MODUL" '(("OSMODE"))) +;; (setq ergebnis +;; (ssg-modul-dialog +;; (strcat lw "/acadsst/pfad/mein_dialog.dcl") +;; "DIALOG_NAME" +;; "DWG_NAME" ; Radio/List-Tile +;; (if (null m_DWG_NAME) "0" m_DWG_NAME) +;; "anzeige" ; Vorschau-Tile +;; (strcat lw "/acadsst/pfad/slb_bibliothek") +;; '("slide0" "slide1" "slide2") +;; nil ; extra-init +;; nil ; extra-read +;; ) +;; ) +;; (if ergebnis +;; (progn +;; (setq m_DWG_NAME ergebnis) +;; (setq pt (ssg-insert-modul "LAYER-NAME" "3" +;; (strcat lw "/acadsst/pfad/block_" ergebnis) +;; (list (cons "GRUPPE" "G1") (cons "ARTINR" "123456")) +;; pause)) +;; ) +;; ) +;; (ssg-end) +;; ) +;; ------------------------------------------------------------ + + +(prompt "\nssg_dialog.lsp geladen.") +(princ) diff --git a/Lisp/ssg_layer.lsp b/Lisp/ssg_layer.lsp new file mode 100644 index 0000000..8e316fe --- /dev/null +++ b/Lisp/ssg_layer.lsp @@ -0,0 +1,315 @@ +;; ============================================================ +;; SSG_LAYER.LSP - Layer-Verwaltungsroutinen +;; Interaktive Layer-Operationen: verschieben, ein/ausschalten, +;; einfrieren, Gruppen-Management. +;; Ursprung: ACADSST/MENU/laymr14.lsp (Schoenenberger) +;; Bereinigt und verallgemeinert: 2025 +;; Setzt ssg_core.lsp voraus. +;; ============================================================ + + +;; ------------------------------------------------------------ +;; LAYER-INFORMATION +;; ------------------------------------------------------------ + +;; Alle Layer als Liste von Layernamen liefern +;; Rueckgabe: Liste von Strings +(defun ssg-layer-list-all (/ result entry first) + (setq result nil + first T + ) + (while (setq entry (tblnext "LAYER" first)) + (setq result (cons (cdr (assoc 2 entry)) result) + first nil + ) + ) + (reverse result) +) + +;; Layer-Infos als Assoziationsliste liefern +;; Rueckgabe: Liste von (name . layer-alist) Paaren +(defun ssg-layer-info-all (/ result entry first) + (setq result nil + first T + ) + (while (setq entry (tblnext "LAYER" first)) + (setq result (cons (cons (cdr (assoc 2 entry)) (cdr entry)) result) + first nil + ) + ) + (reverse result) +) + +;; Layer-Sichtbarkeitsstatus pruefen +;; lay-name = Layername; Rueckgabe: T wenn sichtbar, nil wenn aus/gefroren +(defun ssg-layer-visible-p (lay-name / entry flags color) + (setq entry (tblsearch "LAYER" lay-name)) + (if entry + (progn + (setq flags (cdr (assoc 70 entry)) + color (cdr (assoc 62 entry)) + ) + (and (not (minusp color)) ; nicht ausgeschaltet (negativ = aus) + (= (logand flags 1) 0) ; nicht gefroren (bit 0) + ) + ) + ) +) + +;; Pruefen ob Objekt-Layer der aktive Layer ist (Schutz vor Ausschalten) +;; lay-name = zu pruefender Layer; ist-gruppe = T wenn Gruppen-Layer +;; Rueckgabe: T wenn sicher (nicht aktiver Layer), nil wenn Problem +(defun ssg-layer-safe-p (lay-name ist-gruppe) + (if ist-gruppe + (/= (substr (getvar "CLAYER") 2 2) lay-name) + (/= (getvar "CLAYER") lay-name) + ) +) + + +;; ------------------------------------------------------------ +;; EINFACHE LAYER-OPERATIONEN +;; ------------------------------------------------------------ + +;; Layer eines angeklickten Objektes ermitteln und setzen (aktiv machen) +;; Rueckgabe: neuer Layername oder nil bei Abbruch +(defun c:SSG-LayerSet (/ sel lay) + (ssg-start "Layer setzen" nil) + (if (setq lay (ssg-get-layer "\nObjekt auf dem Ziel-Layer waehlen: ")) + (progn + (command "_LAYER" "_SET" lay "") + (prompt (strcat "\nAktiver Layer: " lay)) + ) + (ssg-emsg "Kein Objekt gewaehlt.") + ) + (ssg-end) + lay +) + +;; Layer eines Objektes anzeigen +(defun c:SSG-LayerInfo (/ sel lay) + (ssg-start "Layer-Info" nil) + (if (setq lay (ssg-get-layer "\nObjekt waehlen: ")) + (prompt (strcat "\nObjekt liegt auf Layer: " lay)) + (ssg-emsg "Kein Objekt gewaehlt.") + ) + (ssg-end) + lay +) + +;; Objekte auf einen anderen Layer verschieben (interaktiv) +(defun c:SSG-LayerMove (/ elem ziel-lay) + (ssg-start "Layer wechseln" nil) + (if (setq elem (ssget)) + (if (setq ziel-lay (ssg-get-layer "\nObjekt auf dem Ziel-Layer waehlen: ")) + (command "_CHANGE" elem "" "_PROP" "_LA" ziel-lay "") + (ssg-emsg "Kein Ziel-Layer gewaehlt.") + ) + (ssg-emsg "Kein Objekt gewaehlt.") + ) + (ssg-end) +) + +;; Objekte auf einen anderen Layer kopieren und dort ablegen +(defun c:SSG-LayerCopy (/ elem ziel-lay) + (ssg-start "Layer-Kopie" nil) + (if (setq elem (ssget)) + (if (setq ziel-lay (ssg-get-layer "\nObjekt auf dem Ziel-Layer waehlen: ")) + (command "_COPY" elem "" "@" "@" "_CHANGE" elem "" "_PROP" "_LA" ziel-lay "") + (ssg-emsg "Kein Ziel-Layer gewaehlt.") + ) + (ssg-emsg "Kein Objekt gewaehlt.") + ) + (ssg-end) +) + +;; Alle Objekte eines Typs auf dem gleichen Layer auf neuen Layer verschieben +;; (nach Auswahl eines Referenz-Objektes dieses Typs) +(defun c:SSG-LayerMoveType (/ ref-lay ref-typ elem ziel-lay ss ref-sel) + (ssg-start "Layer-Typ verschieben" nil) + (if (setq ref-lay (ssg-get-layer "\nReferenz-Objekt waehlen (bestimmt Typ und Layer): ")) + (progn + (setq ref-sel (entsel "\nNochmals fuer Typ-Ermittlung anklicken: ")) + (if ref-sel + (progn + (setq ref-typ (cdr (assoc 0 (entget (car ref-sel)))) + ss (ssg-layer-ss ref-lay ref-typ) + ) + (if ss + (if (setq ziel-lay (ssg-get-layer "\nObjekt auf dem Ziel-Layer waehlen: ")) + (progn + (ssg-zoom-save) + (ssg-ss-redraw ss 3) + (if (not (ssg-ques (strcat "Layer dieser " ref-typ "-Objekte wechseln?") nil)) + (command "_CHANGE" ss "" "_PROP" "_LA" ziel-lay "") + (ssg-ss-redraw ss 4) + ) + (ssg-zoom-restore) + ) + (ssg-emsg "Kein Ziel-Layer.") + ) + (ssg-emsg "Keine passenden Objekte gefunden.") + ) + ) + (ssg-emsg "Abgebrochen.") + ) + ) + (ssg-emsg "Kein Referenz-Objekt gewaehlt.") + ) + (ssg-end) +) + + +;; ------------------------------------------------------------ +;; LAYER EIN-/AUSSCHALTEN UND EINFRIEREN +;; ------------------------------------------------------------ + +;; Layer durch Anklicken ausschalten +(defun c:SSG-LayerOff (/ lay) + (ssg-start "Layer ausschalten" nil) + (while (setq lay (ssg-get-layer "\nLayer zum Ausblenden anklicken (Enter=Ende): ")) + (if (ssg-layer-safe-p lay nil) + (command "_LAYER" "_OFF" lay "") + (ssg-emsg "Aktiven Layer nicht ausschalten!") + ) + ) + (ssg-end) +) + +;; Layer durch Anklicken einfrieren +(defun c:SSG-LayerFreeze (/ lay) + (ssg-start "Layer einfrieren" nil) + (while (setq lay (ssg-get-layer "\nLayer zum Einfrieren anklicken (Enter=Ende): ")) + (if (ssg-layer-safe-p lay nil) + (command "_LAYER" "_FR" lay "") + (ssg-emsg "Aktiven Layer nicht einfrieren!") + ) + ) + (ssg-end) +) + +;; Alle Layer ausser dem aktiven einfrieren +(defun c:SSG-FreezeAll (/ aktiv) + (ssg-start "Alle anderen Layer einfrieren" nil) + (setq aktiv (ssg-get-layer "\nObjekt auf dem Layer waehlen, der AKTIV bleibt: ")) + (if aktiv + (progn + (command "_LAYER" "_SET" aktiv "_FR" "*" "") + (prompt (strcat "\nNur Layer '" aktiv "' ist sichtbar.")) + ) + (ssg-emsg "Abgebrochen.") + ) + (ssg-end) +) + +;; Alle ausgefrorenen Layer wieder auftauen +(defun c:SSG-ThawAll () + (ssg-start "Alle Layer auftauen" nil) + (command "_LAYER" "_T" "*" "") + (ssg-end) +) + +;; Alle ausgeschalteten Layer einschalten +(defun c:SSG-LayerOnAll () + (ssg-start "Alle Layer einschalten" nil) + (command "_LAYER" "_ON" "*" "") + (ssg-end) +) + + +;; ------------------------------------------------------------ +;; LAYER UMBENENNEN / VERSCHIEBEN (Gruppenkonzept) +;; Im Schoenenberger-System haben Layer die Form "X-XX-Name" +;; wobei Position 2-3 die Gruppe identifiziert. +;; Diese Funktionen erlauben das Umbenennen der Gruppen-Kennung. +;; ------------------------------------------------------------ + +;; Gruppen-Buchstaben aus Layernamen extrahieren (Position 2-3) +(defun ssg-layer-group (lay-name) + (substr lay-name 2 2) +) + +;; Neuen Layernamen mit geaenderter Gruppen-Kennung erzeugen +;; lay-name = original; new-grp = neue Gruppen-Kennung (2 Zeichen) +(defun ssg-layer-rename-group (lay-name new-grp) + (strcat (substr lay-name 1 1) new-grp (substr lay-name 4)) +) + +;; Alle Objekte eines Gruppen-Layers auf neuen Gruppen-Layer verschieben +;; old-grp = alte Gruppen-Kennung; new-grp = neue Gruppen-Kennung +(defun ssg-layer-group-move (old-grp new-grp / all-layers entry lay-info new-name + lay-color lay-ltyp c ss i e ed) + (setq all-layers (ssg-layer-info-all)) + (foreach entry all-layers + (if (= (ssg-layer-group (car entry)) old-grp) + (progn + (setq lay-info (cdr entry) + new-name (ssg-layer-rename-group (car entry) new-grp) + c (cdr (assoc 62 lay-info)) + lay-color (if (minusp c) (abs c) c) + lay-ltyp (cdr (assoc 6 lay-info)) + ) + (if (not (tblsearch "LAYER" new-name)) + (command "_LAYER" "_N" new-name "_CO" (itoa lay-color) new-name + "LT" lay-ltyp new-name "") + ) + (setq ss (ssg-layer-ss (car entry) nil)) + (if ss + (progn + (setq i 0) + (while (setq e (ssname ss i)) + (setq ed (entget e)) + (entmod (subst (cons 8 new-name) (assoc 8 ed) ed)) + (setq i (1+ i)) + ) + ) + ) + ) + ) + ) +) + + +;; ------------------------------------------------------------ +;; LAYER LOESCHEN (mit Sicherheitsabfrage) +;; Loescht alle Objekte auf einem Layer und danach den Layer selbst. +;; Nur interaktiv verwenden! +;; ------------------------------------------------------------ +(defun c:SSG-LayerDelete (/ lay ss) + (ssg-start "Layer loeschen" nil) + (initget 1) + (setq lay (getstring "\nLayername zum Loeschen: ")) + (if (tblsearch "LAYER" lay) + (progn + (setq ss (ssg-layer-ss lay nil)) + (if ss + (progn + (ssg-ss-redraw ss 4) + (if (not (ssg-ques (strcat "Alle Objekte auf Layer '" lay "' loeschen?") nil)) + (progn + (command "_ERASE" ss "") + (command "_LAYER" "_OFF" lay "") + (command "_PURGE" "_LA" lay "N") + (prompt (strcat "\nLayer '" lay "' geloescht.")) + ) + (progn + (ssg-ss-redraw ss 0) + (prompt "\nAbgebrochen.") + ) + ) + ) + (progn + (command "_LAYER" "_OFF" lay "") + (command "_PURGE" "_LA" lay "N") + (prompt (strcat "\nLeerer Layer '" lay "' geloescht.")) + ) + ) + ) + (ssg-emsg (strcat "Layer '" lay "' existiert nicht.")) + ) + (ssg-end) +) + + +(prompt "\nssg_layer.lsp geladen.") +(princ) diff --git a/Lisp/ssg_load.lsp b/Lisp/ssg_load.lsp new file mode 100644 index 0000000..9a27c24 --- /dev/null +++ b/Lisp/ssg_load.lsp @@ -0,0 +1,30 @@ +;; ============================================================ +;; SSG_LOAD.LSP - Laderoutine fuer die SSG-Standardbibliotheken +;; +;; Laedt alle SSG-Kernbibliotheken in der richtigen Reihenfolge. +;; In acad.lsp oder manuell aufrufen: +;; (load "pfad/ssg_load.lsp") +;; +;; Alternativ nur einzelne Bibliotheken laden: +;; (load "pfad/ssg_core.lsp") +;; (load "pfad/ssg_layer.lsp") +;; (load "pfad/ssg_dialog.lsp") +;; ============================================================ + +(defun ssg-load-libs (/ base-path) + ;; Pfad dieser Datei als Basis verwenden (AutoCAD 2000+) + (setq base-path + (if (findfile "ssg_core.lsp") + (substr (findfile "ssg_core.lsp") 1 + (- (strlen (findfile "ssg_core.lsp")) (strlen "ssg_core.lsp"))) + (strcat (getvar "DWGPREFIX")) + ) + ) + (load (strcat base-path "ssg_core.lsp") "ssg_core.lsp nicht gefunden") + (load (strcat base-path "ssg_dialog.lsp") "ssg_dialog.lsp nicht gefunden") + (load (strcat base-path "ssg_layer.lsp") "ssg_layer.lsp nicht gefunden") + (prompt "\nSSG-Bibliotheken geladen: ssg_core, ssg_dialog, ssg_layer") + (princ) +) + +(ssg-load-libs) diff --git a/doc/acadsst/HFS/hfs_mod.lsp b/doc/acadsst/HFS/hfs_mod.lsp new file mode 100644 index 0000000..02186dc --- /dev/null +++ b/doc/acadsst/HFS/hfs_mod.lsp @@ -0,0 +1,104 @@ +;------------------------------------------------------------------------; +; ALU-KOMPONENTEN - HFS_MOD.LSP ; +;------------------------------------------------------------------------; +; AW 14.06.97 / 15.8.98 ; +; 16.08.98 - 2-WAY MODUL eingebaut ; +; 06.11.98 - HP-SORT II eingebaut ; +;------------------------------------------------------------------------; +(defun Dbox (/ Dat) + (setq Dat (load_dialog (strcat lw "/acadsst/hfs/HFS_MOD.DCL"))) + (if (not (new_dialog "HFS_MOD" Dat)) (exit)) + (set_tile "DWG_NAME" m_DWG_NAME); Blockname + (mode_tile "anzeige" 0) + (SetDia) + (ACTION_TILE "DWG_NAME" "(zeig_dia)") + (action_tile "accept" "(SetPara) (done_dialog)") + (action_tile "cancel" "(exit) (done_dialog)") + (start_dialog) + (unload_dialog Dat) +) + +(defun SetDia() + (setq breite (dimx_tile "anzeige")) + (setq hoehe (dimy_tile "anzeige")) + (start_image "anzeige") + (FILL_IMAGE 0 0 breite hoehe -18) + (if (= m_DWG_NAME "0") + (slide_image 0 0 breite hoehe "hfs(kmlight)") + ) + (if (= m_DWG_NAME "1") + (slide_image 0 0 breite hoehe "hfs(km3000)") + ) + (if (= m_DWG_NAME "2") + (slide_image 0 0 breite hoehe "hfs(km5000)") + ) + (if (= m_DWG_NAME "3") + (slide_image 0 0 breite hoehe "hfs(hochl)") + ) + (if (= m_DWG_NAME "4") + (slide_image 0 0 breite hoehe "hfs(hfsmod02)") + ) + (if (= m_DWG_NAME "5") + (slide_image 0 0 breite hoehe "hfs(hochltup)") + ) + (if (= m_DWG_NAME "6") + (slide_image 0 0 breite hoehe "hfs(hfsmod01)") + ) + (end_image) +) + +(defun zeig_dia() + (setq m_DWG_NAME (get_tile "DWG_NAME")) + (SetDia) +) + +(defun setpara() + (setq m_DWG_NAME (get_tile "DWG_NAME")) +) + +(defun datain () + (setq dummy nil) +) + +(defun geometrie() + (if (= m_DWG_NAME "0") + (setq BL_NAME "kmlight") + ) + (if (= m_DWG_NAME "1") + (setq BL_NAME "km3000") + ) + (if (= m_DWG_NAME "2") + (setq BL_NAME "km5000") + ) + (if (= m_DWG_NAME "3") + (setq BL_NAME "hochl") + ) + (if (= m_DWG_NAME "4") + (setq BL_NAME "hfsmod02") + ) + (if (= m_DWG_NAME "5") + (setq BL_NAME "hochltup") + ) + (if (= m_DWG_NAME "6") + (setq BL_NAME "hfsmod01") + ) + (command "_layer" "_m" "H-2" "_c" "2" "" "") + (setq P0 (getpoint "\nPick insert point: ")) + (setq BL_NAME (strcat lw "/acadsst/hfs/" BL_NAME)) + (command "_insert" BL_NAME P0 "" "" "0") +) + +;------------------------------------------------------------------------------ +(defun c:HFS_MOD ( / DWG_NAME BL_NAME P0) + (setvar "limcheck" 0) + (setvar "CMDECHO" 0) + (setvar "BLIPMODE" 0) + (setq EINZEL 0) ; fuer EINZEL=0 Baugruppen / EINZEL=1 fuer APB + (prompt "**** HFS MODULS *******") + (prompt "") + (if (null m_DWG_NAME)(setq m_DWG_NAME "0")); Anfangssymbolname + (Dbox) + (prompt "") + (datain) + (geometrie) +) diff --git a/doc/acadsst/ILS2100/ils_ae_elem.lsp b/doc/acadsst/ILS2100/ils_ae_elem.lsp new file mode 100644 index 0000000..8638116 --- /dev/null +++ b/doc/acadsst/ILS2100/ils_ae_elem.lsp @@ -0,0 +1,181 @@ +;------------------------------------------------------------------------; +; ALU-KOMPONENTEN - ILS_AE_ELEM.LSP ; +;------------------------------------------------------------------------; +; AW 14.06.97 / 15.8.98 / 20.9.06 ; +;------------------------------------------------------------------------; +(defun Dbox (/ Dat) + (setq Dat (load_dialog (strcat lw "/acadsst/ils2100/ILS_AE_ELEM.DCL"))) + (if (not (new_dialog "ILS_AE_ELEM" Dat)) (exit)) + (set_tile "DWG_NAME" m_DWG_NAME); Blockname + (set_tile "PNEUM" m_PNEUM) + (mode_tile "anzeige" 0) + (SetDia) + (ACTION_TILE "DWG_NAME" "(zeig_dia)") + (action_tile "accept" "(SetPara) (done_dialog)") + (action_tile "cancel" "(exit) (done_dialog)") + (start_dialog) + (unload_dialog Dat) +) + +(defun SetDia() + (setq breite (dimx_tile "anzeige")) + (setq hoehe (dimy_tile "anzeige")) + (start_image "anzeige") + (FILL_IMAGE 0 0 breite hoehe -18) + (if (= m_DWG_NAME "0") + (slide_image 0 0 breite hoehe "ils2100(29412018)") ; AS LINKS [BG] + ) + (if (= m_DWG_NAME "1") + (slide_image 0 0 breite hoehe "ils2100(29412020)") ; AS RECHTS [BG] + ) + (if (= m_DWG_NAME "2") + (slide_image 0 0 breite hoehe "ils2100(29412021)") ; ES LINKS + ) + (if (= m_DWG_NAME "3") + (slide_image 0 0 breite hoehe "ils2100(29412017)") ; ES RECHTS + ) + (if (= m_DWG_NAME "4") + (slide_image 0 0 breite hoehe "ils2100(29412022)") ; AS LINKS MIT SMC PNEUMATIK + ) + (if (= m_DWG_NAME "5") + (slide_image 0 0 breite hoehe "ils2100(29412023)") ; AS RECHTS MIT SMC PNEUMATIK + ) + (end_image) +) + +(defun zeig_dia() + (setq m_DWG_NAME (get_tile "DWG_NAME")) + (setq m_PNEUM (get_tile "PNEUM")) + (if (or (= m_DWG_NAME "0") (= m_DWG_NAME "1 + ")) ; AS LINKS oder RECHTS als BG + (progn + (mode_tile "PNEUM_1" 0) + (mode_tile "PNEUM_2" 0) + ) + (progn + (mode_tile "PNEUM_1" 1) + (mode_tile "PNEUM_2" 1) + ) + ) + (SetDia) +) + +(defun setpara() + (setq m_DWG_NAME (get_tile "DWG_NAME")) + (setq m_PNEUM (get_tile "PNEUM")) +) + +(defun datain () + (setq dummy nil) +) + +(defun geometrie() + (if (= m_DWG_NAME "0") + (progn + (setq BL_NAME "829412018") + (setq NEV "AS-ELEMENT LINKS ") + (if (= m_PNEUM "PNEUM_1") + (progn + (setq E_ARTINR "829434103") + (setq E_BEZEICHNUNG "BOSCH-PNEUMATIK-SATZ [829434103]") + ) + ) + (if (= m_PNEUM "PNEUM_2") + (progn + (setq E_ARTINR "829434123") + (setq E_BEZEICHNUNG "SMC-PNEUMATIK-SATZ [829434123]") + ) + ) + ) + ) + (if (= m_DWG_NAME "1") + (progn + (setq NEV "AS-ELEMENT RECHTS ") + (setq BL_NAME "829412020") + (if (= m_PNEUM "PNEUM_1") + (progn + (setq E_ARTINR "829434103") + (setq E_BEZEICHNUNG "BOSCH-PNEUMATIK-SATZ [829434103]") + ) + ) + (if (= m_PNEUM "PNEUM_2") + (progn + (setq E_ARTINR "829434123") + (setq E_BEZEICHNUNG "SMC-PNEUMATIK-SATZ [829434123]") + ) + ) + ) + ) + (if (= m_DWG_NAME "2") + (progn + (setq NEV "") + (setq BL_NAME "829412021") + (setq E_ARTINR "") + (setq E_BEZEICHNUNG "") + ) + ) + (if (= m_DWG_NAME "3") + (progn + (setq NEV "") + (setq BL_NAME "829412017") + (setq E_ARTINR "") + (setq E_BEZEICHNUNG "") + ) + ) + (if (= m_DWG_NAME "4") + (progn + (setq NEV "") + (setq BL_NAME "829412022") + (setq E_ARTINR "") + (setq E_BEZEICHNUNG "") + ) + ) + (if (= m_DWG_NAME "5") + (progn + (setq NEV "") + (setq BL_NAME "829412023") + (setq E_ARTINR "") + (setq E_BEZEICHNUNG "") + ) + ) + (command "_layer" "_m" "ILS-AE-AS" "_c" "4" "" "") + (setq P0 (getpoint "\nPick insert point: ")) + (bl-name P0) ;--> Block-Name definieren -> Rckgabe: element-name + (setq BL_NAME (strcat lw "/acadsst/ils2100/" BL_NAME)) + (command "_insert" BL_NAME P0 "" "" pause) + (attribute-aendern "" "" "" "" "" block-kennung "" "" "" "") + + (if (or (= m_DWG_NAME "0") (= m_DWG_NAME "1")) ; AS-Element als BG + (progn + (setq AUSWAHL-SATZ (ssget "_L")) + (EINZELTEIL E_ARTINR E_BEZEICHNUNG "1") + (mach-block P0 "0" AUSWAHL-SATZ) + (attribute-aendern "0" "2" "3" "0" "0" block-kennung "333333333" (strcat NEV "MIT " E_BEZEICHNUNG) "1" "") + ) + ) +) + +(defun EINZELTEIL (E_ARTINR E_BEZEICHNUNG E_MENGE) + (command "_layer" "_m" "ILS-COMPONENTS" "_c" "7" "" "") + (command "_insert" (strcat lw "/acadsst/ils2100/d_einzel") P0 "" "" "0") + (attribute-aendern "0" "0" "23" "" "" block-kennung E_ARTINR E_BEZEICHNUNG E_MENGE "") + (ssadd (entlast) AUSWAHL-SATZ) +) + +;------------------------------------------------------------------------------ +(defun c:ILS_AE_ELEM ( / DWG_NAME BL_NAME P0) + (setvar "limcheck" 0) + (setvar "CMDECHO" 0) + (setvar "BLIPMODE" 0) + (setq ALTFANG (getvar "osmode")) + (setq EINZEL 0) ; fuer EINZEL=0 Baugruppen / EINZEL=1 fuer APB + (prompt "**** ILS MODULS *******") + (prompt "") + (if (null m_DWG_NAME)(setq m_DWG_NAME "0")) ; Anfangssymbolname + (if (null m_PNEUM) (setq m_PNEUM "PNEUM_1")) ; Pneumatik + (Dbox) + (prompt "") + (datain) + (geometrie) + (setvar "osmode" ALTFANG) +) diff --git a/doc/acadsst/ILS2100/ils_anbau_str.lsp b/doc/acadsst/ILS2100/ils_anbau_str.lsp new file mode 100644 index 0000000..b87a8cd --- /dev/null +++ b/doc/acadsst/ILS2100/ils_anbau_str.lsp @@ -0,0 +1,243 @@ +;------------------------------------------------------------------------; +; ALU-KOMPONENTEN - HFS_MOD.LSP ; +;------------------------------------------------------------------------; +; AW 14.06.97 / 15.8.98 / 19.9.06 / 11.01.07 ; +;------------------------------------------------------------------------; +(defun Dbox (/ Dat) + (setq Dat (load_dialog (strcat lw "/acadsst/ils2100/ILS_ANBAU_STR.DCL"))) + (if (not (new_dialog "ILS_ANBAU_STR" Dat)) (exit)) + + (set_tile "DWG_NAME" m_DWG_NAME); Blockname + (set_tile "PNEUM" m_PNEUM) + (set_tile "ANBAU" m_ANBAU) + (set_tile "ABHANG" m_ABHANG) + + (mode_tile "anzeige" 0) + (SetDia) + (ACTION_TILE "DWG_NAME" "(zeig_dia)") + (action_tile "accept" "(SetPara) (done_dialog)") + (action_tile "cancel" "(exit) (done_dialog)") + (start_dialog) + (unload_dialog Dat) +) + +(defun SetDia() + (setq breite (dimx_tile "anzeige")) + (setq hoehe (dimy_tile "anzeige")) + (start_image "anzeige") + (FILL_IMAGE 0 0 breite hoehe -18) + (if (= m_DWG_NAME "0") + (slide_image 0 0 breite hoehe "ils2100(SEP_EH_A)") ; rapid fire LINKS + ) + (if (= m_DWG_NAME "1") + (slide_image 0 0 breite hoehe "ils2100(SEP_EH_B)") ; rapid fire RECHTS + ) + (if (= m_DWG_NAME "2") + (slide_image 0 0 breite hoehe "ils2100(SEP_DH_A)") ; Separator Doppel-Hub (Geflle) LINKS + ) + (if (= m_DWG_NAME "3") + (slide_image 0 0 breite hoehe "ils2100(SEP_DH_B)") ; *SONDER* Separator Doppel-Hub (Geflle) RECHTS + ) + (end_image) +) + +(defun zeig_dia() + (setq m_DWG_NAME (get_tile "DWG_NAME")) + (if (or (= m_DWG_NAME "0") (= m_DWG_NAME "1")) ; Einfach-Hub Separator LINKS oder RECHTS + (progn + (mode_tile "PNEUM" 0) + (mode_tile "ANBAU" 1) + (mode_tile "ABHANG" 0) + ) + ) + (if (= m_DWG_NAME "2") ; Doppel-Hub Separator LINKS + (progn + (setq m_ANBAU "ANBAU_2") + (set_tile "ANBAU" "ANBAU_2") + (mode_tile "PNEUM" 0) + (mode_tile "ANBAU" 0) + (mode_tile "ABHANG" 1) + ) + ) + (if (= m_DWG_NAME "3") ; Doppel-Hub Separator SONDER RECHTS + (progn + (setq m_ANBAU "ANBAU_3") + (set_tile "ANBAU" "ANBAU_3") + (mode_tile "PNEUM" 0) + (mode_tile "ANBAU" 0) + (mode_tile "ABHANG" 1) + ) + ) + (SetDia) +) + +(defun setpara() + (setq m_DWG_NAME (get_tile "DWG_NAME")) + (setq m_PNEUM (get_tile "PNEUM")) + (setq m_ABHANG (get_tile "ABHANG")) + (setq m_ANBAU (get_tile "ANBAU")) +) + +(defun datain () + (setq dummy nil) +) + +(defun geometrie() + (if (= m_DWG_NAME "0") + (progn + (setq NEV "SEPARATOR 1-HUB LINKS") + (setq BL_NAME "829432001A") + (PNEUM_SEP) + ) + ) + (if (= m_DWG_NAME "1") + (progn + (setq NEV "SEPARATOR 1-HUB RECHTS") + (setq BL_NAME "829432001B") + (PNEUM_SEP) + ) + ) + (if (= m_DWG_NAME "2") + (progn + (setq NEV "SEPARATOR 2-HUEBE LINKS") + (setq BL_NAME "829432005A") + (PNEUM_GEFAELLE) + ) + ) + (if (= m_DWG_NAME "3") + (progn + (setq NEV "SEPARATOR 2-HUEBE RECHTS [*SONDER*]") + (setq BL_NAME "829432005B") + (PNEUM_GEFAELLE) + ) + ) + + (command "_layer" "_m" "ILS-COMPONENTS" "_c" "7" "" "") + (setq P0 (getpoint "\nPick insert point: ")) + (bl-name P0) ;--> Block-Name definieren -> Rckgabe: element-name + (setq BL_NAME (strcat lw "/acadsst/ils2100/" BL_NAME)) + (command "_insert" BL_NAME P0 "" "" pause) + (attribute-aendern "" "" "" "" "" block-kennung "" "" "" "") + + (setq AUSWAHL-SATZ (ssget "_L")) + + ;<<< Pneumatik setzen + (EINZELTEIL E_ARTINR E_BEZEICHNUNG "1" "0") + ;<<< Abhnger fr Einfach-Hub Separator + (if (or (= m_DWG_NAME "0") (= m_DWG_NAME "1")) + (ABHAENGER) + ) + ;<<< Fr Separator in Geflle immer das gleiche Profil + (if (or (= m_DWG_NAME "2") (= m_DWG_NAME "3")) + (progn + (EINZELTEIL "829434312" "ABHAENGUNG F.SEP.GEFAELLESTRECKE KPL." "1" "20") + (setq NEV (strcat NEV "+" "ABH.GEFAELLE")) + ) + ) + + ;<<< Anbau [LINKS ]fr Separator Doppel-Hub + (if (or (= m_DWG_NAME "2") (= m_DWG_NAME "3")) + (progn + (if (= m_ANBAU "ANBAU_2") + (progn + (EINZELTEIL "829434320" "ANBAU [LINKS] MT-TRAVERSENSTOPPER AN SEP. KPL." "1" "30") + (setq NEV (strcat NEV "+" "ANBAU [LINKS] MT")) + ) + ) + (if (= m_ANBAU "ANBAU_3") + (progn + (EINZELTEIL "829434321" "ANBAU [RECHTS] MT-TRAVERSENSTOPPER AN SEP. KPL." "1" "30") + (setq NEV (strcat NEV "+" "ANBAU [RECHTS] MT")) + ) + ) + ) + ) + + (mach-block P0 "0" AUSWAHL-SATZ) + (setq NEV (strcat NEV " KPL.")) + (attribute-aendern "0" "2" "3" "0" "0" block-kennung "333333333" NEV "1" "") + +) + +(defun PNEUM_SEP () + (if (= m_PNEUM "PNEUM_1") + (progn + (setq E_ARTINR "829434101") + (setq E_BEZEICHNUNG "BOSCH-PNEUM.F.EINFACH-HUB KPL.[829434101]") + (setq NEV (strcat NEV "+" "BOSCH")) + ) + ) + (if (= m_PNEUM "PNEUM_2") + (progn + (setq E_ARTINR "829434121") + (setq E_BEZEICHNUNG "SMC-PNEUM.F:EINFACH-HUB KPL.[829434121]") + (setq NEV (strcat NEV "+" "SMC")) + ) + ) +) + +(defun PNEUM_GEFAELLE () + (if (= m_PNEUM "PNEUM_1") + (progn + (setq E_ARTINR "829434100") + (setq E_BEZEICHNUNG "BOSCH-PNEUM.F.DOPPEL-HUB KPL.[829434100]") + (setq NEV (strcat NEV "+" "BOSCH")) + ) + ) + (if (= m_PNEUM "PNEUM_2") + (progn + (setq E_ARTINR "829434120") + (setq E_BEZEICHNUNG "SMC-PNEU.F.DOPPEL-HUB KPL.[829434120]") + (setq NEV (strcat NEV "+" "SMC")) + ) + ) +) + +(defun ABHAENGER () + (if (= m_ABHANG "ABHANG_1") ; Abhngung an Monster-Profil LP + (progn + (EINZELTEIL "829434310" "ABHAENGUNG F.SEP.AN TRAEGERPROFIL" "1" "10") + (setq NEV (strcat NEV "+" "ABH.MONSTER-LP")) + ) + ) + (if (= m_ABHANG "ABHANG_2") ; Abhngung an Monster-Profil LP fr PIN + (progn + (EINZELTEIL "829434310" "ABHAENGUNG F.SEP.AN TRAEGERPROFIL" "1" "10") + (setq NEV (strcat NEV "+" "ABH.MONSTER-LP F.PIN")) + ) + ) + (if (= m_ABHANG "ABHANG_3") ; Abhngung an LP + (progn + (EINZELTEIL "829434311" "ABHAENGUNG F.SEP.AN LP KPL." "1" "10") + (setq NEV (strcat NEV "+" "ABH.AN LP")) + ) + ) +) + +(defun EINZELTEIL (E_ARTINR E_BEZEICHNUNG E_MENGE WINKEL) + (command "_layer" "_m" "ILS-COMPONENTS" "_c" "7" "" "") + (command "_insert" (strcat lw "/acadsst/ils2100/d_einzel") P0 "" "" WINKEL) + (attribute-aendern "0" "0" "23" "" "" block-kennung E_ARTINR E_BEZEICHNUNG E_MENGE "") + (ssadd (entlast) AUSWAHL-SATZ) +) + +;------------------------------------------------------------------------------ +(defun c:ILS_ANBAU_STR ( / DWG_NAME BL_NAME P0) + (setvar "limcheck" 0) + (setvar "CMDECHO" 0) + (setvar "BLIPMODE" 0) + (setq ALTFANG (getvar "osmode")) + (setq EINZEL 0) ; fuer EINZEL=0 Baugruppen / EINZEL=1 fuer APB + (prompt "**** ILS SEPARATOR/STOPPER *******") + (prompt "") + (if (null m_DWG_NAME) (setq m_DWG_NAME "0")) ; Anfangssymbolname + (if (null m_PNEUM) (setq m_PNEUM "PNEUM_2")) ; SMC Pneumatik + (if (null m_ABHANG) (setq m_ABHANG "ABHANG_1")) ; Abhnger + (if (null m_ANBAU) (setq m_ANBAU "ANBAU_1")) ; Anbaubaugruppe fr Separator Doppelhub + + (Dbox) + (prompt "") + (datain) + (geometrie) + (setvar "osmode" ALTFANG) +) diff --git a/doc/acadsst/ILS2100/ils_angebot.lsp b/doc/acadsst/ILS2100/ils_angebot.lsp new file mode 100644 index 0000000..5e218ea --- /dev/null +++ b/doc/acadsst/ILS2100/ils_angebot.lsp @@ -0,0 +1,383 @@ +;------------------------------------------------------------------------; +; ILS 2100 ANGEBOT ; +;------------------------------------------------------------------------; +; AW 18.11.2007 ; +; 23.01.2009 Bereinigung und Ergnzung ; +;------------------------------------------------------------------------; +(defun Dbox (/ Dat) + (setq Dat (load_dialog (strcat lw "/acadsst/ils2100/ILS_ANGEBOT.DCL"))) + (if (not (new_dialog "ILS_ANGEBOT" Dat)) (exit)) + (set_tile "DWG_NAME" m_DWG_NAME); Blockname + (set_tile "RICHT" m_RICHT) + (mode_tile "anzeige" 0) + (SetDia) + + (ACTION_TILE "DWG_NAME" "(zeig_dia)") + (ACTION_TILE "RICHT" "(zeig_dia)") + + (action_tile "accept" "(SetPara) (done_dialog)") + (action_tile "cancel" "(exit) (done_dialog)") + (start_dialog) + (unload_dialog Dat) +) + +(defun SetDia() + (setq breite (dimx_tile "anzeige")) + (setq hoehe (dimy_tile "anzeige")) + (start_image "anzeige") + (FILL_IMAGE 0 0 breite hoehe -18) + + (if (= m_DWG_NAME "0") ; Antrieb 800 + (slide_image 0 0 breite hoehe "ils2100(B3000010)") + ) + (if (= m_DWG_NAME "1") ; Spannstation 800 + (slide_image 0 0 breite hoehe "ils2100(B3000030)") + ) + (if (= m_DWG_NAME "2") ; Umlenkstation 800 + (slide_image 0 0 breite hoehe "ils2100(B3000050)") + ) + (if (= m_DWG_NAME "3") ; Antrieb 300 + (slide_image 0 0 breite hoehe "ils2100(B3000020)") + ) + (if (= m_DWG_NAME "4") ; Spannstation 300 + (slide_image 0 0 breite hoehe "ils2100(B3000040)") + ) + (if (= m_DWG_NAME "5") ; AS + (progn + (if (= m_RICHT "LINKS") + (slide_image 0 0 breite hoehe "ils2100(B300020L)") + (slide_image 0 0 breite hoehe "ils2100(B300020R)") + ) + ) + ) + (if (= m_DWG_NAME "6") ; ES + (progn + (if (= m_RICHT "LINKS") + (slide_image 0 0 breite hoehe "ils2100(B300021L)") + (slide_image 0 0 breite hoehe "ils2100(B300021R)") + ) + ) + ) + (if (= m_DWG_NAME "7") ; Separator + (slide_image 0 0 breite hoehe "ils2100(B3000150)") + ) + (if (= m_DWG_NAME "8") ; Geflle + (slide_image 0 0 breite hoehe "ils2100(B3000160)") + ) + (if (= m_DWG_NAME "9") ; Scanner fr BM + (slide_image 0 0 breite hoehe "ils2100(B3000170)") + ) + (if (= m_DWG_NAME "10") ; Scanner manuell fr Bekleidung + (slide_image 0 0 breite hoehe "ils2100(B3000171)") + ) + (if (= m_DWG_NAME "11") ; Scanner automatisch + (slide_image 0 0 breite hoehe "ils2100(B3000175)") + ) + (if (= m_DWG_NAME "12") ; Beladung + (slide_image 0 0 breite hoehe "ils2100(B3000320)") + ) + (if (= m_DWG_NAME "13") ; Entladung + (slide_image 0 0 breite hoehe "ils2100(B3000310)") + ) + (if (= m_DWG_NAME "14") ; AE 30 GRAD rechts/links + (progn + (if (= m_RICHT "LINKS") + (slide_image 0 0 breite hoehe "ils2100(B3000340)") + (slide_image 0 0 breite hoehe "ils2100(B3000345)") + ) + ) + ) + (if (= m_DWG_NAME "15") ; ETF Umlenkung rechts/links + (progn + (if (= m_RICHT "LINKS") + (slide_image 0 0 breite hoehe "ils2100(B3000360)") + (slide_image 0 0 breite hoehe "ils2100(B3000365)") + ) + ) + ) + (if (= m_DWG_NAME "16") ; ETF Antrieb rechts/links + (progn + (if (= m_RICHT "LINKS") + (slide_image 0 0 breite hoehe "ils2100(B3000350)") + (slide_image 0 0 breite hoehe "ils2100(B3000355)") + ) + ) + ) + (if (= m_DWG_NAME "17") ; EE 30 GRAD rechts/links + (progn + (if (= m_RICHT "LINKS") + (slide_image 0 0 breite hoehe "ils2100(B3000330)") + (slide_image 0 0 breite hoehe "ils2100(B3000335)") + ) + ) + ) + (if (= m_DWG_NAME "18") ; ETF kompl. rechts/links + (progn + (if (= m_RICHT "LINKS") + (slide_image 0 0 breite hoehe "ils2100(ETF_L)") + (slide_image 0 0 breite hoehe "ils2100(ETF_R)") + ) + ) + ) + + (end_image) +) + +(defun zeig_dia() + (setq m_DWG_NAME (get_tile "DWG_NAME")) + (setq m_RICHT (get_tile "RICHT")) + + (if (= m_DWG_NAME "0") ; Antrieb 800 + (mode_tile "RICHT" 1) + ) + (if (= m_DWG_NAME "1") ; Spannstation 800 + (mode_tile "RICHT" 1) + ) + (if (= m_DWG_NAME "2") ; Umlenkstation 800 + (mode_tile "RICHT" 1) + ) + (if (= m_DWG_NAME "3") ; Antrieb 300 + (mode_tile "RICHT" 1) + ) + (if (= m_DWG_NAME "4") ; Spannstation 300 + (mode_tile "RICHT" 1) + ) + (if (= m_DWG_NAME "5") ; AS + (mode_tile "RICHT" 0) + ) + (if (= m_DWG_NAME "6") ; ES + (mode_tile "RICHT" 0) + ) + (if (= m_DWG_NAME "7") ; Separator + (mode_tile "RICHT" 1) + ) + (if (= m_DWG_NAME "8") ; Geflle + (mode_tile "RICHT" 1) + ) + (if (= m_DWG_NAME "9") ; Scanner fr BM + (mode_tile "RICHT" 1) + ) + (if (= m_DWG_NAME "10") ; Scanner manuell fr Bekleidung + (mode_tile "RICHT" 1) + ) + (if (= m_DWG_NAME "11") ; Scanner automatisch + (mode_tile "RICHT" 1) + ) + (if (= m_DWG_NAME "12") ; Beladung + (mode_tile "RICHT" 1) + ) + (if (= m_DWG_NAME "13") ; Entladung + (mode_tile "RICHT" 1) + ) + (if (= m_DWG_NAME "14") ; AE 30 GRAD rechts/links + (mode_tile "RICHT" 0) + ) + (if (= m_DWG_NAME "15") ; ETF Umlenkung rechts/links + (mode_tile "RICHT" 0) + ) + (if (= m_DWG_NAME "16") ; ETF Antrieb rechts/links + (mode_tile "RICHT" 0) + ) + (if (= m_DWG_NAME "17") ; EE 30 GRAD rechts/links + (mode_tile "RICHT" 0) + ) + (if (= m_DWG_NAME "18") ; ETF kompl. rechts/links + (mode_tile "RICHT" 0) + ) + + (SetDia) +) + +(defun setpara() + (setq m_DWG_NAME (get_tile "DWG_NAME")) + (setq m_RICHT (get_tile "RICHT")) +) + +(defun datain () + (setq dummy nil) +) + +(defun geometrie() + (setq NEV "") + (setq E_ARTINR "") + (setq E_BEZEICHNUNG "") + + (if (= m_DWG_NAME "0") ; Antrieb 800 + (progn + (command "_layer" "_m" "ILS-ANTRIEB" "_c" "1" "" "") + (setq BL_NAME "0_B3000010") + ) + ) + (if (= m_DWG_NAME "1") ; Spannstation 800 + (progn + (command "_layer" "_m" "ILS-SPANNSTATION" "_c" "2" "" "") + (setq BL_NAME "0_B3000030") + ) + ) + (if (= m_DWG_NAME "2") ; Umlenkstation 800 + (progn + (command "_layer" "_m" "ILS-UMLENKSTATION" "_c" "2" "" "") + (setq BL_NAME "0_B3000050") + ) + ) + (if (= m_DWG_NAME "3") ; Antrieb 300 + (progn + (command "_layer" "_m" "ILS-ANTRIEB" "_c" "1" "" "") + (setq BL_NAME "0_B3000020") + ) + ) + (if (= m_DWG_NAME "4") ; Spannstation 300 + (progn + (command "_layer" "_m" "ILS-SPANNSTATION" "_c" "2" "" "") + (setq BL_NAME "0_B3000040") + ) + ) + (if (= m_DWG_NAME "5") ; AS + (progn + (command "_layer" "_m" "ILS-AS" "_c" "1" "" "") + (if (= m_RICHT "LINKS") + (setq BL_NAME "0_B3000200_L") + (setq BL_NAME "0_B3000200_R") + ) + ) + ) + (if (= m_DWG_NAME "6") ; ES + (progn + (command "_layer" "_m" "ILS-ES" "_c" "7" "" "") + (if (= m_RICHT "LINKS") + (setq BL_NAME "0_B3000210_L") + (setq BL_NAME "0_B3000210_R") + ) + ) + ) + (if (= m_DWG_NAME "7") ; Separator + (progn + (command "_layer" "_m" "ILS-SP" "_c" "3" "" "") + (setq BL_NAME "0_B3000150") + ) + ) + (if (= m_DWG_NAME "8") ; Separator Geflle + (progn + (command "_layer" "_m" "ILS-SP-G" "_c" "4" "" "") + (setq BL_NAME "0_B3000160") + ) + ) + (if (= m_DWG_NAME "9") ; Scanner fr Betriebsmittel + (progn + (command "_layer" "_m" "ILS-SCANNER" "_c" "5" "" "") + (setq BL_NAME "0_B3000170") + ) + ) + (if (= m_DWG_NAME "10") ; Handscanner + (progn + (command "_layer" "_m" "ILS-SCANNER" "_c" "5" "" "") + (setq BL_NAME "0_B3000171") + ) + ) + (if (= m_DWG_NAME "11") ; Automatik Scanner fr die Ware + (progn + (command "_layer" "_m" "ILS-SCANNER" "_c" "5" "" "") + (setq BL_NAME "0_B3000175") + ) + ) + (if (= m_DWG_NAME "12") ; Beladung + (progn + (command "_layer" "_m" "ILS-BELADUNG" "_c" "3" "" "") + (setq BL_NAME "0_B3000320") + ) + ) + (if (= m_DWG_NAME "13") ; Entladung + (progn + (command "_layer" "_m" "ILS-ENTLADUNG" "_c" "4" "" "") + (setq BL_NAME "0_B3000310") + ) + ) + (if (= m_DWG_NAME "14") ; AE 30 GRAD rechts/links + (progn + (command "_layer" "_m" "ILS-ETF" "_c" "6" "" "") + (if (= m_RICHT "LINKS") + (setq BL_NAME "0_B3000340") + (setq BL_NAME "0_B3000345") + ) + ) + ) + (if (= m_DWG_NAME "15") ; ETF Umlenkung rechts/links + (progn + (command "_layer" "_m" "ILS-ETF" "_c" "6" "" "") + (if (= m_RICHT "LINKS") + (setq BL_NAME "0_B3000360") + (setq BL_NAME "0_B3000365") + ) + ) + ) + (if (= m_DWG_NAME "16") ; ETF Antrieb rechts/links + (progn + (command "_layer" "_m" "ILS-ETF" "_c" "6" "" "") + (if (= m_RICHT "LINKS") + (setq BL_NAME "0_B3000350") + (setq BL_NAME "0_B3000355") + ) + ) + ) + (if (= m_DWG_NAME "17") ; EE 30 GRAD rechts/links + (progn + (command "_layer" "_m" "ILS-ETF" "_c" "6" "" "") + (if (= m_RICHT "LINKS") + (setq BL_NAME "0_B3000330") + (setq BL_NAME "0_B3000335") + ) + ) + ) + (if (= m_DWG_NAME "18") ; ETF kompl. rechts/links + (progn + (command "_layer" "_m" "ILS-ETF" "_c" "6" "" "") + (if (= m_RICHT "LINKS") + (setq BL_NAME "ETF_L") + (setq BL_NAME "ETF_R") + ) + ) + ) + + + (setq P0 (getpoint "\nPick insert point: ")) +; (bl-name P0) ;--> Block-Name definieren -> Rckgabe: element-name + (setq BL_NAME (strcat lw "/acadsst/ils2100/" BL_NAME)) + (command "_insert" BL_NAME P0 "" "" pause) +; (attribute-aendern "" "" "" "" "" block-kennung "" "" "" "") + +;---------------------------------------------------------------------- +; (if (or (= m_DWG_NAME "0") (= m_DWG_NAME "1")) ; AS-Element +; (progn +; (setq AUSWAHL-SATZ (ssget "_L")) +; (EINZELTEIL E_ARTINR E_BEZEICHNUNG "1") +; (mach-block P0 "0" AUSWAHL-SATZ) +; (attribute-aendern "0" "2" "3" "0" "0" block-kennung "333333333" (strcat NEV "MIT " E_BEZEICHNUNG) "1" "") +; ) +; ) +;---------------------------------------------------------------------- +) + +;(defun EINZELTEIL (E_ARTINR E_BEZEICHNUNG E_MENGE) +; (command "_layer" "_m" "ILS-COMPONENTS" "_c" "7" "" "") +; (command "_insert" (strcat lw "/acadsst/ils2100/d_einzel") P0 "" "" "0") +; (attribute-aendern "0" "0" "23" "" "" block-kennung E_ARTINR E_BEZEICHNUNG E_MENGE "") +; (ssadd (entlast) AUSWAHL-SATZ) +;) + +;------------------------------------------------------------------------------ +(defun c:ILS_ANGEBOT ( / DWG_NAME BL_NAME P0) + (setvar "limcheck" 0) + (setvar "CMDECHO" 0) + (setvar "BLIPMODE" 0) + (setq ALTFANG (getvar "osmode")) + (setq EINZEL 0) ; fuer EINZEL=0 Baugruppen / EINZEL=1 fuer APB + (prompt "**** ILS ANGEBOT MOULE *******") + (prompt "") + (if (null m_DWG_NAME)(setq m_DWG_NAME "0")) ; Anfangssymbolname + (if (null m_RICHT) (setq m_RICHT "LINKS")) ; Richtung + (Dbox) + (prompt "") + (datain) + (geometrie) + (setvar "osmode" ALTFANG) +) diff --git a/doc/acadsst/ILS2100/ils_angebot_module.lsp b/doc/acadsst/ILS2100/ils_angebot_module.lsp new file mode 100644 index 0000000..3851c7e --- /dev/null +++ b/doc/acadsst/ILS2100/ils_angebot_module.lsp @@ -0,0 +1,175 @@ +;------------------------------------------------------------------------; +; ILS 2100 - ANGEBOTSMODULE ; +;------------------------------------------------------------------------; +; AW 17.10.06 ; +;------------------------------------------------------------------------; +(defun Dbox (/ Dat) + (setq Dat (load_dialog (strcat lw "/acadsst/ils2100/ILS_ANGEBOT_MODULE.DCL"))) + (if (not (new_dialog "ILS_ANGEBOT_MODULE" Dat)) (exit)) + (set_tile "DWG_NAME" m_DWG_NAME); Blockname + (set_tile "ART" m_ART) + (mode_tile "anzeige" 0) + (SetDia) + (ACTION_TILE "DWG_NAME" "(zeig_dia)") + (action_tile "accept" "(SetPara) (done_dialog)") + (action_tile "cancel" "(exit) (done_dialog)") + (start_dialog) + (unload_dialog Dat) +) + +(defun SetDia() + (setq breite (dimx_tile "anzeige")) + (setq hoehe (dimy_tile "anzeige")) + (start_image "anzeige") + (FILL_IMAGE 0 0 breite hoehe -18) + (if (= m_DWG_NAME "0") + (slide_image 0 0 breite hoehe "ils2100(modul1)") + ) + (if (= m_DWG_NAME "1") + (slide_image 0 0 breite hoehe "ils2100(modul2)") + ) + (if (= m_DWG_NAME "2") + (slide_image 0 0 breite hoehe "ils2100(modul3)") + ) + (if (= m_DWG_NAME "3") + (slide_image 0 0 breite hoehe "ils2100(modul4)") + ) + (if (= m_DWG_NAME "4") + (slide_image 0 0 breite hoehe "ils2100(modul5)") + ) + (if (= m_DWG_NAME "5") + (slide_image 0 0 breite hoehe "ils2100(modul1_3)") + ) + (if (= m_DWG_NAME "6") + (slide_image 0 0 breite hoehe "ils2100(modul2_3)") + ) + (end_image) +) + +(defun zeig_dia() + (setq m_DWG_NAME (get_tile "DWG_NAME")) + (SetDia) +) + +(defun setpara() + (setq m_DWG_NAME (get_tile "DWG_NAME")) + (setq m_ART (get_tile "ART")) +) + +(defun datain () + (setq dummy nil) +) + +(defun geometrie() + (if (= m_DWG_NAME "0") + (progn + (setq NEV "SEPARATOR LINKS - RAD") + (setq BL_NAME "829432001") + (PNEUM_SEP) + ) + ) + (if (= m_DWG_NAME "1") + (progn + (setq NEV "SEPARATOR RECHTS - RAD") + (setq BL_NAME "829432002") + (PNEUM_SEP) + ) + ) + (if (= m_DWG_NAME "2") + (progn + (setq NEV "SEPARATOR LINKS - LP") + (setq BL_NAME "829432003") + (PNEUM_SEP) + ) + ) + (if (= m_DWG_NAME "3") + (progn + (setq NEV "SEPARATOR RECHTS - LP") + (setq BL_NAME "829432004") + (PNEUM_SEP) + ) + ) + (if (= m_DWG_NAME "4") + (progn + (setq NEV "SEPARATOR SP") + (setq BL_NAME "829432005") + (PNEUM_GEFAELLE) + ) + ) + (if (= m_DWG_NAME "5") + (progn + (setq NEV "STOPPER - SP") + (setq BL_NAME "829432006") + (PNEUM_GEFAELLE) + ) + ) + + + (command "_layer" "_m" "ILS-COMPONENTS" "_c" "8" "" "") + (setq P0 (getpoint "\nPick insert point: ")) + (bl-name P0) ;--> Block-Name definieren -> Rckgabe: element-name + (setq BL_NAME (strcat lw "/acadsst/ils2100/" BL_NAME)) + (command "_insert" BL_NAME P0 "" "" pause) + (attribute-aendern "" "" "" "" "" block-kennung "" "" "" "") + + (setq AUSWAHL-SATZ (ssget "_L")) + (EINZELTEIL E_ARTINR E_BEZEICHNUNG "1") + (mach-block P0 "0" AUSWAHL-SATZ) + (attribute-aendern "0" "2" "3" "0" "0" block-kennung "333333333" (strcat NEV "MIT " E_BEZEICHNUNG) "1" "") + +) + +(defun EINZELTEIL (E_ARTINR E_BEZEICHNUNG E_MENGE) + (command "_layer" "_m" "ILS-COMPONENTS" "_c" "8" "" "") + (command "_insert" (strcat lw "/acadsst/ils2100/d_einzel") P0 "" "" "0") + (attribute-aendern "0" "0" "23" "" "" block-kennung E_ARTINR E_BEZEICHNUNG E_MENGE "") + (ssadd (entlast) AUSWAHL-SATZ) +) + +(defun PNEUM_SEP () + (if (= m_PNEUM "PNEUM_1") + (progn + (setq E_ARTINR "829 434 101") + (setq E_BEZEICHNUNG "BOSCH-PNEUMATIK-SATZ") + ) + ) + (if (= m_PNEUM "PNEUM_2") + (progn + (setq E_ARTINR "829 434 121") + (setq E_BEZEICHNUNG "SMC-PNEUMATIK-SATZ") + ) + ) +) + +(defun PNEUM_GEFAELLE () + (if (= m_PNEUM "PNEUM_1") + (progn + (setq E_ARTINR "829434100") + (setq E_BEZEICHNUNG "BOSCH-PNEUMATIK-SATZ") + ) + ) + (if (= m_PNEUM "PNEUM_2") + (progn + (setq E_ARTINR "829434120") + (setq E_BEZEICHNUNG "SMC-PNEUMATIK-SATZ") + ) + ) +) + +;------------------------------------------------------------------------------ +(defun c:ILS_ANBAU_STR ( / DWG_NAME BL_NAME P0) + (setvar "limcheck" 0) + (setvar "CMDECHO" 0) + (setvar "BLIPMODE" 0) + (setq ALTFANG (getvar "osmode")) + (setq EINZEL 0) ; fuer EINZEL=0 Baugruppen / EINZEL=1 fuer APB + (prompt "**** ILS SEPARATORS/STOPPER *******") + (prompt "") + (if (null m_DWG_NAME)(setq m_DWG_NAME "0")) ; Anfangssymbolname + (if (null m_PNEUM) (setq m_PNEUM "PNEUM_1")) ; Pneumatik + (Dbox) + (prompt "") + (datain) + (geometrie) + (setvar "osmode" ALTFANG) +) diff --git a/doc/acadsst/ILS2100/ils_sensor.lsp b/doc/acadsst/ILS2100/ils_sensor.lsp new file mode 100644 index 0000000..a2c85a3 --- /dev/null +++ b/doc/acadsst/ILS2100/ils_sensor.lsp @@ -0,0 +1,94 @@ +;------------------------------------------------------------------------; +; ALU-KOMPONENTEN - ils_sensor.LSP ; +;------------------------------------------------------------------------; +; AW 14.06.97 / 15.8.98 / 20.9.06 ; +;------------------------------------------------------------------------; +(defun Dbox (/ Dat) + (setq Dat (load_dialog (strcat lw "/acadsst/ils2100/ils_sensor.DCL"))) + (if (not (new_dialog "ils_sensor" Dat)) (exit)) + (set_tile "DWG_NAME" m_DWG_NAME); Blockname + (mode_tile "anzeige" 0) + (SetDia) + (ACTION_TILE "DWG_NAME" "(zeig_dia)") + (action_tile "accept" "(SetPara) (done_dialog)") + (action_tile "cancel" "(exit) (done_dialog)") + (start_dialog) + (unload_dialog Dat) +) + +(defun SetDia() + (setq breite (dimx_tile "anzeige")) + (setq hoehe (dimy_tile "anzeige")) + (start_image "anzeige") + (FILL_IMAGE 0 0 breite hoehe -18) + (if (= m_DWG_NAME "0") + (slide_image 0 0 breite hoehe "ils2100(27422001)") + ) + (if (= m_DWG_NAME "1") + (slide_image 0 0 breite hoehe "ils2100(27422002)") + ) + (if (= m_DWG_NAME "2") + (slide_image 0 0 breite hoehe "ils2100(27422003)") + ) + (if (= m_DWG_NAME "3") + (slide_image 0 0 breite hoehe "ils2100(27422004)") + ) + (if (= m_DWG_NAME "4") + (slide_image 0 0 breite hoehe "ils2100(29422039)") + ) + (end_image) +) + +(defun zeig_dia() + (setq m_DWG_NAME (get_tile "DWG_NAME")) + (SetDia) +) + +(defun setpara() + (setq m_DWG_NAME (get_tile "DWG_NAME")) +) + +(defun datain () + (setq dummy nil) +) + +(defun geometrie() + (if (= m_DWG_NAME "0") + (setq BL_NAME "827422001") + ) + (if (= m_DWG_NAME "1") + (setq BL_NAME "827422002") + ) + (if (= m_DWG_NAME "2") + (setq BL_NAME "827422003") + ) + (if (= m_DWG_NAME "3") + (setq BL_NAME "827422004") + ) + (if (= m_DWG_NAME "4") + (setq BL_NAME "829422039") + ) + (command "_layer" "_m" "ILS-AUTOMATION" "_c" "1" "" "") + (setq P0 (getpoint "\nPick insert point: ")) + (bl-name P0) ;--> Block-Name definieren -> Rckgabe: element-name + (setq BL_NAME (strcat lw "/acadsst/ils2100/" BL_NAME)) + (command "_insert" BL_NAME P0 "" "" pause) + (attribute-aendern "" "" "" "" "" block-kennung "" "" "" "") +) + +;------------------------------------------------------------------------------ +(defun c:ils_sensor ( / DWG_NAME BL_NAME P0) + (setvar "limcheck" 0) + (setvar "CMDECHO" 0) + (setvar "BLIPMODE" 0) + (setq ALTFANG (getvar "osmode")) + (setq EINZEL 0) ; fuer EINZEL=0 Baugruppen / EINZEL=1 fuer APB + (prompt "**** ILS MODULS *******") + (prompt "") + (if (null m_DWG_NAME)(setq m_DWG_NAME "0")); Anfangssymbolname + (Dbox) + (prompt "") + (datain) + (geometrie) + (setvar "osmode" ALTFANG) +) diff --git a/doc/acadsst/ILS2100/ils_verb_str.lsp b/doc/acadsst/ILS2100/ils_verb_str.lsp new file mode 100644 index 0000000..ad666b6 --- /dev/null +++ b/doc/acadsst/ILS2100/ils_verb_str.lsp @@ -0,0 +1,107 @@ +;------------------------------------------------------------------------; +; ALU-KOMPONENTEN - HFS_MOD.LSP ; +;------------------------------------------------------------------------; +; AW 14.06.97 / 15.8.98 / 20.9.06 ; +;------------------------------------------------------------------------; +(defun Dbox (/ Dat) + (setq Dat (load_dialog (strcat lw "/acadsst/ils2100/ils_verb_str.DCL"))) + (if (not (new_dialog "ils_verb_str" Dat)) (exit)) + (set_tile "DWG_NAME" m_DWG_NAME); Blockname + (mode_tile "anzeige" 0) + (SetDia) + (ACTION_TILE "DWG_NAME" "(zeig_dia)") + (action_tile "accept" "(SetPara) (done_dialog)") + (action_tile "cancel" "(exit) (done_dialog)") + (start_dialog) + (unload_dialog Dat) +) + +(defun SetDia() + (setq breite (dimx_tile "anzeige")) + (setq hoehe (dimy_tile "anzeige")) + (start_image "anzeige") + (FILL_IMAGE 0 0 breite hoehe -18) + (if (= m_DWG_NAME "0") + (slide_image 0 0 breite hoehe "ils2100(29412013)") + ) + (if (= m_DWG_NAME "1") + (slide_image 0 0 breite hoehe "ils2100(29412009)") + ) + (if (= m_DWG_NAME "2") + (slide_image 0 0 breite hoehe "ils2100(29414007)") + ) + (if (= m_DWG_NAME "3") + (slide_image 0 0 breite hoehe "ils2100(29414008)") + ) + (if (= m_DWG_NAME "4") + (slide_image 0 0 breite hoehe "ils2100(29422035)") + ) + (if (= m_DWG_NAME "5") + (slide_image 0 0 breite hoehe "ils2100(29422029)") + ) + (if (= m_DWG_NAME "6") + (slide_image 0 0 breite hoehe "ils2100(29422028)") + ) + (end_image) +) + +(defun zeig_dia() + (setq m_DWG_NAME (get_tile "DWG_NAME")) + (SetDia) +) + +(defun setpara() + (setq m_DWG_NAME (get_tile "DWG_NAME")) +) + +(defun datain () + (setq dummy nil) +) + +(defun geometrie() + (if (= m_DWG_NAME "0") + (setq BL_NAME "829412013") + ) + (if (= m_DWG_NAME "1") + (setq BL_NAME "829412009") + ) + (if (= m_DWG_NAME "2") + (setq BL_NAME "829414007") + ) + (if (= m_DWG_NAME "3") + (setq BL_NAME "829414008") + ) + (if (= m_DWG_NAME "4") + (setq BL_NAME "829422035") + ) + (if (= m_DWG_NAME "5") + (setq BL_NAME "829422029") + ) + (if (= m_DWG_NAME "6") + (setq BL_NAME "829422028") + ) + + (command "_layer" "_m" "ILS-COMPONENTS" "_c" "4" "" "") + (setq P0 (getpoint "\nPick insert point: ")) + (bl-name P0) ;--> Block-Name definieren -> Rckgabe: element-name + (setq BL_NAME (strcat lw "/acadsst/ils2100/" BL_NAME)) + (command "_insert" BL_NAME P0 "" "" pause) + (attribute-aendern "" "" "" "" "" "ZZZZZZZZZ" "" "" "" "") +) + +;------------------------------------------------------------------------------ +(defun c:ils_verb_str ( / DWG_NAME BL_NAME P0) + (setvar "limcheck" 0) + (setvar "CMDECHO" 0) + (setvar "BLIPMODE" 0) + (setq ALTFANG (getvar "osmode")) + (setq EINZEL 0) ; fuer EINZEL=0 Baugruppen / EINZEL=1 fuer APB + (prompt "**** ILS MODULS *******") + (prompt "") + (if (null m_DWG_NAME)(setq m_DWG_NAME "0")); Anfangssymbolname + (Dbox) + (prompt "") + (datain) + (geometrie) + (setvar "osmode" ALTFANG) +) diff --git a/doc/acadsst/MENU/laymr14.lsp b/doc/acadsst/MENU/laymr14.lsp new file mode 100644 index 0000000..2c20e38 --- /dev/null +++ b/doc/acadsst/MENU/laymr14.lsp @@ -0,0 +1,462 @@ +;............................................................ +;: DATE : 92-01-01 Kunde: tewi : +;: Autor: Schmidt AutoCAD-Version 11 : +;: Version 1.1 ab Version 10 mit anpassen : +;: : +;: LAYM14.LSP Layer-Manager : +;:..........................................................: + +(SPECIAL '(grp)) + +(DEFUN zoal () ;Zoom af + (SETQ vsiz (GETVAR "VIEWSIZE")) + (COMMAND "_ZOOM" "_V") +) + +(DEFUN zovo () ;Zoom vorher, wenn mglich + (IF (/= (GETVAR "VIEWSIZE") vsiz) + (COMMAND "_ZOOM" "_P") + ) +) + +(DEFUN mdis (/ mlau) + (SETQ mlau 26) + (GRTEXT 0 "LAY-MAN") + (GRTEXT 1 " ") + (GRTEXT 2 " ? ") + (GRTEXT 3 " SET ") + (GRTEXT 4 "COPY GR.") + (GRTEXT 5 "MOVE GR.") + (GRTEXT 6 "MOVE EL ") + (GRTEXT 7 "MOVE ALL") + (GRTEXT 8 "ON LAYER") + (GRTEXT 9 "OFF LAYR") + (GRTEXT 10 "TAU LAY.") + (GRTEXT 11 "FR LAYER") + (GRTEXT 12 "FR ALL ") + (GRTEXT 13 "DEL LAY.") + (GRTEXT 14 "LAY.SELE") + (GRTEXT 15 " ") + (GRTEXT 16 " ") + (GRTEXT 17 " ") + (GRTEXT 18 " ") + (GRTEXT 19 " ") + (GRTEXT 20 " ") + (GRTEXT 21 " ") + (GRTEXT 22 " ") + (GRTEXT 23 " ") + (GRTEXT 24 " ") + (GRTEXT 25 " ") + (WHILE (< mlau mlen) + (GRTEXT mlau " ") + (SETQ mlau (1+ mlau)) + ) +) +(DEFUN ssgad (nset gset / slau seln) ;SSET zu SSET addieren + (SETQ slau 0) + (IF (NULL (EVAL (READ gset)))(SET (READ gset)(SSADD))) + (WHILE (SETQ seln (SSNAME nset slau)) + (SSADD seln (EVAL (READ gset))) + (REDRAW seln 3) + (SETQ slau (1+ slau)) + ) +) + +(DEFUN ared (aset ltyp / asla asna) ;Ausleuchten von Elementen. + (SETQ asla 0) + (WHILE (SETQ asna (SSNAME aset asla)) + (REDRAW asna ltyp) + (SETQ asla (1+ asla)) + ) +) + +(DEFUN alay (txt) ;Layername filtern + (IF (SETQ akel (ENTSEL txt)) + (CDR (ASSOC '8 (ENTGET (CAR akel)))) + ) + +) + +(defun alel (tele elna) ;Elemente filtern + (IF elna + (SSGET "X" (LIST (CONS '0 elna)(CONS '8 tele))) + (SSGET "X" (LIST (CONS '8 tele))) + ) +) + +(DEFUN lann (nwna ngna) ;Layer new name + (STRCAT (SUBSTR nwna 1 1) ngna (SUBSTR nwna 4)) +) + +(DEFUN laqu (/ lach) ;Layer Gruppenname + (SETQ lach "-" + last (SUBSTR (STRCASE (GETSTRING "Group-Letter: <_> ")) 1 2) + last (COND + ((= (STRLEN last) 2) last) + ((= (STRLEN last) 1) (STRCAT last lach)) + ( T (STRCAT lach lach)) + ) + ) +) + +(DEFUN ltes (tlay grou) ;ausschalt Kontrolle + (IF (OR (AND (= (SUBSTR (GETVAR "CLAYER") 2 2) tlay) grou) + (AND (= (GETVAR "CLAYER") tlay) (NOT grou)) + ) + (emsg "change first active layer") + T + ) +) + +(DEFUN layl (/ lext ltan) ;Layerliste + (SETQ ltan T) + (WHILE (SETQ lext (TBLNEXT "LAYER" ltan)) + (SETQ laex (CONS (CONS (CDADR lext) (CDDR lext)) laex) + ltan NIL + ) + ) +) + +(DEFUN ldis (/ run lauf llen) ;Layer am Seitenmenu anz. + (SETQ run T + lauf 0 + llen (LENGTH clis) + ) + (WHILE run + (WHILE (< lauf mlen) + (IF (< lpos llen) + (GRTEXT lauf (NTH lpos clis)) + (GRTEXT lauf " ") + ) ;Menuanzeige + (SETQ lauf (1+ lauf) + lpos (1+ lpos) + ) + ;um 1 erhhen + ) + (IF (> lpos mlen) + (GRTEXT mlen "Prev. ") + (GRTEXT mlen " ") + ) ;Rckschalten + (IF (> (- llen lpos) 0) + (GRTEXT (1+ mlen) "Next ") + (GRTEXT (1+ mlen) " ") + ) ;Vorwrtsschalten + (IF (= (CAR (SETQ antw (GRREAD))) 4) + (IF (< (CADR antw) mlen) + ;wenn gltige Antwort + (IF (> (SETQ antw (+ (CADR antw)(- lpos lauf))) llen) + (SETQ antw NIL run NIL) + (SETQ run NIL + lpos (IF (= (- lpos mlen) (1- llen)) + (- lpos mlen mlen) + (- lpos mlen) + ) + ) + ) + (COND + ((AND (= (CADR antw) mlen)(> lpos mlen)) + ;Vorher + (SETQ lpos (- lpos mlen mlen) + lauf 0 + ) + ) + ((AND (= (CADR antw) (1+ mlen))(> llen lpos)) + ;Nchst + (SETQ lauf 0) + ) + (T (emsg "False Field !")) + ) + ) + (SETQ antw NIL run NIL) + ) + ) +) + +(DEFUN lays (ein / clis lpos laex antw atly akly llau lcom) ;Layer schalten + (SETQ lpos 0) + (layl) + (IF ein + (FOREACH xpos laex + (IF (MINUSP (CDR (ASSOC 62 (CDR xpos)))) + (SETQ clis (CONS (CAR xpos) clis)) + ) + ) + (FOREACH xpos laex + (IF (= (CDR (ASSOC 70 (CDR xpos))) 65) + (SETQ clis (CONS (CAR xpos) clis)) + ) + ) + ) + (WHILE clis + (PRINC "\nSelect Layer from the Screen Menu: ") + (ldis) + (IF antw + (SETQ atly (NTH antw clis) + akly (CONS atly akly) + clis (APPEND (REVERSE (CDR (MEMBER atly (REVERSE clis)))) + (CDR (MEMBER atly clis)) + ) + ) + (SETQ clis NIL) + ) + ) + (IF akly + (PROGN + (SETQ llau 0 + lcom (IF ein "_ON" "_T") + ) + (PRINC "\n\nPlease wait ...") + (COMMAND "_LAYER") + (REPEAT (LENGTH akly) + (COMMAND lcom (NTH llau akly)) + (SETQ llau (1+ llau)) + ) + (COMMAND "") + ) + (emsg "Nothing selected!") + ) +) + +(DEFUN laye (/ lacg lauf lant) ;Layer neuer Auswahlsatz + (SETQ lacg (SSLENGTH chgr) + lauf 0 + ) + (REPEAT lacg + (IF (NOT (MEMBER (SETQ lant (CDR (ASSOC 8 (ENTGET + (SSNAME chgr lauf))))) lanl)) + (SETQ lanl (CONS lant lanl)) + ) + (SETQ lauf (1+ lauf)) + ) +) + +(DEFUN layc (/ lall lauf lane linf laco nlna chel laol nwel) ;Layer change + (SETQ lall (LENGTH lanl) + lauf 0 + ) + (REPEAT lall + (IF (NOT (ASSOC (lann (NTH lauf lanl) last) laex)) + (SETQ lane (CONS (NTH lauf lanl) lane)) + ) + (SETQ lauf (1+ lauf)) + ) + (SETQ lall (LENGTH lane) + lauf 0 + ) + (REPEAT lall + (SETQ linf (CDR (ASSOC (NTH lauf lane) laex)) + laco (IF (MINUSP (SETQ lico (CDR (ASSOC 62 linf))))(ABS lico) lico) + nlna (lann (NTH lauf lane) last) + ) + (COMMAND "_LAYER" "_N" nlna "_CO" lico nlna "LT" (CDR (ASSOC 6 linf)) nlna "") + (SETQ lauf (1+ lauf)) + ) + (SETQ lall (SSLENGTH chgr) + lauf 0 + ) + (REPEAT lall + (SETQ chel (ENTGET (SSNAME chgr lauf)) + laol (ASSOC 8 chel) + nwel (SUBST (CONS 8 (lann (CDR laol) last)) laol chel) + ) + (ENTMOD nwel) + (SETQ lauf (1+ lauf)) + ) +) + +(DEFUN lgrn (cona / lpos lgri clis lnwn lnaw lsta ltmp lntp ldtp lddb last) ;Layer Gruppenmanipulationen + (SETQ lpos 0) + (layl) + (FOREACH xpos laex + (IF (SETQ lgri (SUBSTR (CAR xpos) 2 2)) + (IF clis + (IF (NOT (MEMBER lgri clis)) + (SETQ clis (CONS lgri clis)) + ) + (SETQ clis (LIST lgri)) + ) + ) + ) + (IF clis + (PROGN + (PRINC "\nSelect group from the Screen Menu: ") + (ldis) + (IF antw + (PROGN + (SETQ lnwn (STRCAT "?" (NTH antw clis) "*")) + (COND + ((= cona "_OFF") + (IF (ltes (NTH antw clis) T) + (COMMAND "_LAYER" "_OFF" lnwn "") + ) + ) + ((= cona "DEL") + (SETQ lnaw (NTH antw clis) + lsta T + ) + (zoal) + (WHILE (SETQ ltmp (TBLNEXT "LAYER" lsta)) + (IF (= (SUBSTR (SETQ lntp (CDR (ASSOC 2 ltmp))) 2 2) lnaw) + (IF (SETQ ldtp (SSGET "X" (LIST (CONS 8 lntp)))) + (ssgad ldtp "lddb") + ) + ) + (SETQ lsta NIL) + ) + (IF lddb + (IF (ques "Delete this Elements?" NIL) + (COMMAND "_ERASE" lddb "") + (ared lddb 4) + ) + ) + (zovo) + ) + ((= cona "WAHL") + (SETQ lnaw (NTH antw clis) + lsta T + ) + (WHILE (SETQ ltmp (TBLNEXT "LAYER" lsta)) + (IF (= (SUBSTR (SETQ lntp (CDR (ASSOC 2 ltmp))) 2 2) lnaw) + (IF (SETQ ldtp (SSGET "X" (LIST (CONS 8 lntp)))) + (ssgad ldtp "lddb") + ) + ) + (SETQ lsta NIL) + ) + (IF lddb + (PROGN + (PRINC "\nThis Elements are now saved as !GRP") + (PRINC "\nPress any key to continue...") + (GRREAD) + (SETQ grp lddb) + (ared lddb 4) + ) + (emsg "No elements found..!") + ) + ) + (T (COMMAND "_LAYER" cona lnwn "")) + ) + ) + (emsg "Nothing selected!") + ) + ) + ) +) + +(DEFUN laymanag (sele layn / vsiz elem elet akna akel akly clay lanl last) ;Hauptprogramm + (IF (NOT runm) + (pstart "Layer - Manager" "" '(("REGENMODE"))) + ) + (COND + ((= sele 2) + (IF (SETQ akly (alay "\nObjekt whlen\n")) + (PRINC (STRCAT "\nElement ist auf Layer " akly)) + ) + ) + ((= sele 3) + (IF (SETQ akly (alay "\nZiel-Ebene whlen\n")) + (PROGN + (COMMAND "_LAYER" "_SET" akly "") + (SETQ cavar (SUBST (CONS "CLAYER" akly) + (ASSOC '"CLAYER" cavar) cavar) + ) + ) + ) + ) + ((= sele 4) + (IF (SETQ elem (ssget)) + (IF (SETQ akly (alay "\nObjekt auf dem Ziel-Ebene whlen\n")) + (COMMAND "_COPY" elem "" "@" "@" "_CHANGE" elem "" "_PROP" "_LA" akly "") + (emsg "Kein Layer gewhlt! ") + ) + (emsg "Kein Objekt gewhlt! ") + ) + ) + ((= sele 5) + (IF (SETQ elem (ssget)) + (IF (SETQ akly (alay "\nObjekt auf dem Ziel-Ebene whlen\n")) + (COMMAND "_CHANGE" elem "" "_PROP" "_LA" akly "") + (emsg "Kein Layer gewhlt") + ) + (emsg "Kein Objekt gewhlt") + ) + ) + ((= sele 6) + (IF (SETQ akly (alay "\nZu nderndes Objekt whlen\n")) + (PROGN + (SETQ akna (CDR (ASSOC '0 (ENTGET (CAR akel))))) + (IF (SETQ elem (alel akly akna)) + (IF (SETQ akly (alay "Select object on the target layer:\n")) + (PROGN + (zoal) + (ared elem 3) + (IF (ques (STRCAT "Layer von " + (COND + ((= akna "LINE") "Line") + ((= akna "CIRCLE") "Circle") + ((= akna "ARC") "Arc") + ((= akna "POINT") "Point") + ((= akna "PLINE") "Polylie") + ( T akna) + ) + " ndern?") NIL) + (COMMAND "_CHANGE" elem "" "_PROP" "_LA" akly "") + (ared elem 4) + ) + (zovo) + ) + (emsg "Kein Layer gewhlt") + ) + ) + ) + (emsg "Kein Object gewhlt") + ) + ) + ((= sele 7) + (IF (SETQ akly (alay "\nDie zu ndernden Objekte whlen\n")) + (IF (SETQ elem (alel akly NIL)) + (IF (SETQ akly (alay "Objekt auf der Ziel-Ebene whlen\n")) + (PROGN + (zoal) + (ared elem 3) + (IF (ques "Layer fr diese Objekte ndern ?" NIL) + (COMMAND "_CHANGE" elem "" "_PROP" "_LA" akly "") + (ared elem 4) + ) + (zovo) + ) + (emsg "Kein Layer gewhlt") + ) + ) + (emsg "Kein Objekt gewhlt") + ) + ) + ((= sele 8)(lays T)) + ((= sele 9) + (WHILE (SETQ akly (alay "\nLayer zum Ausblenden\n")) + (IF (ltes akly nil) + (COMMAND "_LAYER" "_OFF" akly "") + ) + ) + ) + ((= sele 10)(lays NIL)) + ((= sele 11) + (WHILE (SETQ akly (alay "\nLayer FRIEREN\n")) + (IF (ltes akly nil) + (COMMAND "_LAYER" "_FR" akly "") + ) + ) + ) + ((= sele 12) + (SETQ clay (alay "\nObjekt auf dem aktiven Layer der aktiv bleibt whlen\n")) + (COMMAND "_LAYER" "_SET" clay "_FR" "*" "") + ) + ) + (IF (NOT runm) + (pend) + ) +) + +(PRINC) +(PRINC "\n Layermanager loaded") +(PRINC) diff --git a/doc/acadsst/MENU/ssg.lsp b/doc/acadsst/MENU/ssg.lsp new file mode 100644 index 0000000..1d23470 --- /dev/null +++ b/doc/acadsst/MENU/ssg.lsp @@ -0,0 +1,518 @@ +(IF SPECIAL + (SPECIAL '(olde ptest cavar bell prna)) + (DEFUN SPECIAL (x) nil) +) +(DEFUN pstart (tit qust setv / xlen xpos xvar) + (SETQ olde *ERROR* + *ERROR* (IF ptest NIL errhan) + cavar (APPEND '(("CLAYER")("CMDECHO")) + setv) + xlen (LENGTH cavar) + xpos 0 + ) + (REPEAT xlen + (SETQ xvar (CAR (NTH xpos cavar)) + cavar (SUBST (CONS xvar (GETVAR xvar)) + (NTH xpos cavar) cavar) + xpos (1+ xpos) + ) + ) + (SETVAR "CMDECHO" 0) + (COMMAND "_undo" "_G") + (GRAPHSCR) + (PROMPT (STRCAT "\n***** " tit " *****\n\n " qust)) + (PRINC) +) +(DEFUN pend (/ xpos xlen xvar) + (IF cavar + (PROGN + (COMMAND) + (COMMAND "_undo" "_E") + (SETQ xpos 1 + xlen (LENGTH cavar) + ) + (IF (/= (GETVAR "CLAYER") (CAAR cavar)) + (COMMAND "_LAYER" "_SE" (CDAR CAVAR) "") + ) + (REPEAT (1- xlen) + (SETQ xvar (NTH xpos cavar) + xpos (1+ xpos) + ) + (SETVAR (CAR xvar)(CDR xvar)) + ) + ) + ) + (IF olde (SETQ *ERROR* olde)) + (PRINC) +) +(DEFUN errhan (em) + (IF (= em "Function cancelled") + (PRINC) + (PRINC em) + ) + (GRTEXT) + (COMMAND) + (COMMAND) + (pend) +) +(DEFUN ques (dial defa) ;Std Abfrage + (IF defa + (PROGN + (INITGET 1 "Yes No Yes") + (= (GETKWORD (STRCAT "\n" dial " Y/N : ")) "No") + ) + (PROGN + (INITGET 1 "Yes No No") + (= (GETKWORD (STRCAT "\n" dial " Y/N : ")) "Yes") + ) + ) +) +(DEFUN emsg (etxt) + (IF (NOT bell)(PROMPT "\007")) + (TERPRI) + (PROMPT etxt) + (TERPRI) +) +(DEFUN ques (dial defa) ;Std Abfrage + (IF defa + (PROGN + (INITGET 1 "Yes No Yes") + (= (GETKWORD (STRCAT "\n" dial " Y/N : ")) "No") + ) + (PROGN + (INITGET 1 "Yes No No") + (= (GETKWORD (STRCAT "\n" dial " Y/N : ")) "Yes") + ) + ) +) +(DEFUN renv (envn prnn / penv) + (IF (SETQ penv (GETENV envn)) + (EVAL (STRCAT penv "" prnn)) + (EVAL prnn) + ) +) +(DEFUN C:PRG (/ nprg cprg prna) + (SETQ nprg (GETSTRING) + cprg (STRCAT "C:" nprg) + prna (renv "ACADLSP" nprg) + ) + (IF (NULL (EVAL (READ cprg))) + (PROGN + (PRINC " loading...!\n") + (COND + ((FINDFILE (STRCAT prna ".BI4")) + (LOAD prna ".BI4")) + ((FINDFILE (STRCAT prna ".BI2")) + (LOAD prna ".BI2")) + ((FINDFILE (STRCAT prna ".LSP")) + (LOAD prna ".LSP")) + ( T (emsg "File not found")) + ) + ) + ) + (PRINC) +) +(DEFUN C:ed (/ prnn) + (IF (NULL prna) + (SETQ prna "") + ) + (SETQ prnn (GETSTRING + (STRCAT "Programname <" prna ">: "))) + (IF (AND (= (STRLEN prna) 0)(= (STRLEN prnn) 0)) + (emsg "Name not allowed...") + (PROGN + (IF (> (STRLEN prnn) 0) + (SETQ prna (renv "ACADLSP" prnn)) + ) + (COMMAND "SHELL" (STRCAT "ED " prna )) + (INITGET 1 "Yes No Yes") + (IF (NOT (ques "Load the program" T)) + (LOAD prna) + ) + ) + ) + (PRINC) +) +;----------- Block einfuegen mit Layergenerierung ----2.8.92 AW +; KEINE DREHMOEGLICHKEIT !!! +(DEFUN c:symplac ( / einp); / einp ebene symname) + (SETQ einp (GETPOINT "\nInsert-Point: ")) + (COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "") + (COMMAND "_insert" symname einp "" "" "0") +) +;----------- Block einfuegen mit Layergenerierung ----14.8.92 AW +; MIT DREHMOEGLICHKEIT !!! +(DEFUN c:sympl_dr ( / einp); / einp ebene symname) + (SETQ einp (GETPOINT "\nInsert-Point: ")) + (COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "") + (COMMAND "_insert" symname einp "" "" pause) +) +;----------- Block einfuegen mit Layergenerierung ---16.9.93 AW +; MIT DREHMOEGLICHKEIT UND URSPRUNG NACH DEM SETZEN !!! +(DEFUN c:sympldr2 ( / einp drehung groesse) + (setq groesse "1") + (SETQ einp (GETPOINT "\nInsert-Point: ")) + (SETQ drehung (GETSTRING "\nRotation: ")) + (SETQ groesse (GETSTRING "\nScale: ")) + (COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "") + (COMMAND "_insert" symname einp groesse groesse drehung) + (COMMAND "_explode" "_last") +) +;----------- Block einfuegen mit Layergenerierung ---21.11.93 AW +; ABFRAGE: SKALIERUNG/ DREHMOEGLICHKEIT UND URSPRUNG NACH DEM SETZEN !!! +(DEFUN c:sympldr1 ( / einp drehung) + (SETQ einp (GETPOINT "\nInsert-Point: ")) + (SETQ drehung (GETSTRING "\nRotation: ")) + (COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "") + (COMMAND "_insert" symname einp "" "" drehung) + (COMMAND "_explode" "_last") +) +;----------- Block einfuegen mit Layergenerierung und Skalierung ---12.2.93 AW +(DEFUN c:sym_scal ( / einp p1 p2); / einp ebene symname) + (SETQ einp (GETPOINT "\nInsert-Point: ")) + (SETQ p1 (GETREAL "\nX-Scale: ")) + (SETQ p2 (GETREAL "\nY-Scale: ")) + (COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "") + (COMMAND "_insert" symname einp p1 p2 "0") +) + +;------------ Farbe aendern - AUFRUF aus POP2-------------------------- +(DEFUN c:alt_farb ( / sst_obj neuefarb) + (setq sst_obj (ssget) neuefarb (getstring "\nNew-Color: ")) + (command "_change" sst_obj "" "_prop" "_co" neuefarb "") +) +;-------------------------------------------------------------------- + +(defun block-op (PT0 szoeg auswahl-satz / komponente1 komponente2 + seconds element-name gefunden) + ;------------------ + ; Block definieren + ;----------------------------------------------------------- + ; PT0 - Origin der Baugruppe + ; szoeg - Einfuegewinkel + ; auswahl-satz - Elemente des Blockes in Auswahlsatz + ;------------------------------------------------------------ + (setq komponente1 (strcat (itoa (abs (fix (car PT0)))) (itoa (abs (fix (cadr PT0)))) + (itoa (abs (fix (caddr PT0)))))) + (setq komponente2 szoeg) + (setq seconds (substr (rtos (getvar "cdate") 2 9) 10 9)) + (setq element-name (strcat komponente1 komponente2 seconds)) + (princ) + (princ (strcat komponente1 "\n")) + (princ (strcat komponente2 "\n")) + (princ (strcat seconds "\n")) + (princ) + (princ (strcat "\n" element-name "\n")) + (princ) + (setq gefunden (tblsearch "block" element-name)) + (if (not gefunden) + (progn + (princ) + (command "_block" element-name PT0 auswahl-satz "") + (command "_insert" element-name PT0 "" "" szoeg) + ) + (progn + (alert (strcat "\nBlockname: " element-name " already exists." )) + (setq element-name (strcat "x" element-name)) + (alert (strcat "\nCorrected blockname: " element-name " .OK!")) + (command "_block" element-name PT0 auswahl-satz "") + (command "_insert" element-name PT0 "" "" szoeg) + ) + ) +) + +(defun bl-name (PT0 / komponente1 seconds) +; 14.4.94 +; Verwendung bei Baugruppen, deren Bestandteile aufgelistet +; werden mssen. +; Name eines Blockes gleich am Anfang des Programmes festlegen +; - die Einzelkomponenten werden in "C" mit diesem Wert belegt +; - dadurch ist eine eindeutige Gruppenzugeh"rigkeit m"glich +; + (setq komponente1 (strcat (itoa (abs (fix (car PT0)))) (itoa (abs (fix (cadr PT0)))) + (itoa (abs (fix (caddr PT0)))))) + (setq seconds (substr (rtos (getvar "cdate") 2 9) 10 9)) + (setq block-kennung (strcat komponente1 seconds)) + (princ) +) + +(defun mach-block-ohne-prop (PT0 szoeg auswahl-satz / komponente1 komponente2 + seconds element-name gefunden) + ;------------------ + ; Block definieren + ;----------------------------------------------------------- + ; PT0 - Origin der Baugruppe + ; szoeg - Einfuegewinkel + ; auswahl-satz - Elemente des Blockes in Auswahlsatz + ;------------------------------------------------------------ + (setq komponente1 (strcat (itoa (abs (fix (car PT0)))) (itoa (abs (fix (cadr PT0)))) + (itoa (abs (fix (caddr PT0)))))) + (setq komponente2 szoeg) + (setq seconds (substr (rtos (getvar "cdate") 2 9) 10 9)) + (setq element-name (strcat komponente1 komponente2 seconds)) + (princ) + (princ (strcat komponente1 "\n")) + (princ (strcat komponente2 "\n")) + (princ (strcat seconds "\n")) + (princ) + (princ (strcat "\n" element-name "\n")) + (princ) + (setq gefunden (tblsearch "block" element-name)) + (if (not gefunden) + (progn + (princ) + (command "_block" element-name PT0 auswahl-satz "") + (command "_insert" element-name PT0 "" "" szoeg) + ) + (alert "\nBlockname exists. You need HELP !") + ) +) + + +(defun mach-block (PT0 szoeg auswahl-satz / komponente1 komponente2 + seconds element-name gefunden) + ;------------------ + ; Block definieren + ;----------------------------------------------------------- + ; PT0 - Origin der Baugruppe + ; szoeg - Einfuegewinkel + ; auswahl-satz - Elemente des Blockes in Auswahlsatz + ;------------------------------------------------------------ + (setq komponente1 (strcat (itoa (abs (fix (car PT0)))) (itoa (abs (fix (cadr PT0)))) + (itoa (abs (fix (caddr PT0)))))) + (setq komponente2 szoeg) + (setq seconds (substr (rtos (getvar "cdate") 2 9) 10 9)) + (setq element-name (strcat komponente1 komponente2 seconds)) + (princ) + (princ (strcat komponente1 "\n")) + (princ (strcat komponente2 "\n")) + (princ (strcat seconds "\n")) + (princ) + (princ (strcat "\n" element-name "\n")) + (princ) + (setq gefunden (tblsearch "block" element-name)) + (if (not gefunden) + (progn + (princ) + (command "_insert" (strcat "*" lw "/acadsst/menu/a") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/b") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/c") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/artinr") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/beschr") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/menge") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/position") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/gruppe") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/etikette") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/aufloese") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_block" element-name PT0 auswahl-satz "") + (command "_insert" element-name PT0 "" "" szoeg) + ) + (alert "\nBlockname exists. You need HELP !") + ) +) + +;---------- Attribute aendern - Laenge,Endstueck,Artikel-Nr.-------------------- +(defun ATTRIBUTE-AENDERN (M_POSITION M_ETIKETTE M_GRUPPE M_A M_B M_C M_ARTINR + M_BESCHR M_MENGE M_AUFLOESE / objekt typ + attribut-bezeichnung attribut-wert) + (setq objekt (entlast)) + (while (not (equal + (cdr (assoc 0 (entget objekt))) + "SEQEND")) + (setq typ + (cdr (assoc 0 (entget objekt)))) + (if + (equal typ "ATTRIB") + (progn + (setq ATTRIBUT-BEZEICHNUNG (cdr (assoc 2 (entget objekt)))) + (setq ATTRIBUT-WERT (cdr (assoc 1 (entget objekt)))) + + (if (and (> (strlen M_POSITION) 0) (= ATTRIBUT-BEZEICHNUNG "POSITION")) + (entmod (subst (cons 1 M_POSITION) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_ETIKETTE) 0) (= ATTRIBUT-BEZEICHNUNG "ETIKETTE")) + (entmod (subst (cons 1 M_ETIKETTE) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_GRUPPE) 0) (= ATTRIBUT-BEZEICHNUNG "GRUPPE")) + (entmod (subst (cons 1 M_GRUPPE) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_A) 0) (equal ATTRIBUT-BEZEICHNUNG "A")) + (entmod (subst (cons 1 M_A) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_B) 0) (equal ATTRIBUT-BEZEICHNUNG "B")) + (entmod (subst (cons 1 M_B) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_C) 0) (equal ATTRIBUT-BEZEICHNUNG "C")) + (entmod (subst (cons 1 M_C) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_ARTINR) 0) (equal ATTRIBUT-BEZEICHNUNG "ARTINR")) + (entmod (subst (cons 1 M_ARTINR) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_BESCHR) 0) (equal ATTRIBUT-BEZEICHNUNG "BESCHR")) + (entmod (subst (cons 1 (strcat ATTRIBUT-WERT M_BESCHR)) + (assoc 1 (entget objekt)) (entget objekt))) + ) + (if (and (> (strlen M_MENGE) 0) (equal ATTRIBUT-BEZEICHNUNG "MENGE")) + (entmod (subst (cons 1 M_MENGE) + (assoc 1 (entget objekt)) (entget objekt))) + ) + (if (and (> (strlen M_AUFLOESE) 0) (equal ATTRIBUT-BEZEICHNUNG "AUFLOESE")) + (entmod (subst (cons 1 M_AUFLOESE) + (assoc 1 (entget objekt)) (entget objekt))) + ) + ) ; Ende ----progn + ) ; Ende ----if + (setq objekt (entnext objekt)) + ) + (setq objekt objekt) +) + +;---------- Attribute aendern - Laenge,Endstueck,Artikel-Nr.-------------------- +(defun ATTRIBUTE-AENDERN_IO (M_IO M_ID M_VERW M_BEZEICHNUNG M_KENNZEICHNUNG M_SPS / objekt typ attribut-bezeichnung attribut-wert) + (setq objekt (entlast)) + (while (not (equal + (cdr (assoc 0 (entget objekt))) + "SEQEND")) + (setq typ + (cdr (assoc 0 (entget objekt)))) + (if + (equal typ "ATTRIB") + (progn + (setq ATTRIBUT-BEZEICHNUNG (cdr (assoc 2 (entget objekt)))) + (setq ATTRIBUT-WERT (cdr (assoc 1 (entget objekt)))) + + (if (and (> (strlen M_IO) 0) (= ATTRIBUT-BEZEICHNUNG "IO")) + (entmod (subst (cons 1 M_IO) (assoc 1 (entget objekt)) + (entget objekt))) + ) + + (if (and (> (strlen M_ID) 0) (= ATTRIBUT-BEZEICHNUNG "ID")) + (entmod (subst (cons 1 M_ID) (assoc 1 (entget objekt)) + (entget objekt))) + ) + + (if (and (> (strlen M_VERW) 0) (= ATTRIBUT-BEZEICHNUNG "VERW")) + (entmod (subst (cons 1 M_VERW) (assoc 1 (entget objekt)) + (entget objekt))) + ) + + (if (and (> (strlen M_BEZEICHNUNG) 0) (= ATTRIBUT-BEZEICHNUNG "BEZEICHNUNG")) + (entmod (subst (cons 1 M_BEZEICHNUNG) (assoc 1 (entget objekt)) + (entget objekt))) + ) + + (if (and (> (strlen M_KENNZEICHNUNG) 0) (= ATTRIBUT-BEZEICHNUNG "KENNZEICHNUNG")) + (entmod (subst (cons 1 M_KENNZEICHNUNG) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_SPS) 0) (= ATTRIBUT-BEZEICHNUNG "SPS")) + (entmod (subst (cons 1 M_SPS) (assoc 1 (entget objekt)) + (entget objekt))) + ) + ) ; Ende ----progn + ) ; Ende ----if + + (setq objekt (entnext objekt)) + ) + (setq objekt objekt) +) + + +;--- Objekt in der DB suchen und Attribut "ndern --------------- +; Parameter: +; ref - handle +; bezeichnung - Attributbezeichnung, die gesucht ist +; wert - neuer Wert +; addition = 0 - Attributbezeichnung wird mit "wert" ersetzt +; 1 - Attributbezeichnung wird mit "wert" erg"nzt +;---------------------------------------------------------------- +(defun suchen-aendern ( ref bezeichnung wert addition + / typ attribut-bezeichnung attribut-wert) + (redraw (handent ref) 3) + (obj-suchen ref) + (redraw (handent ref)) +) + +(defun obj-suchen (ref) + (setq raus 0) + (setq e (entnext)) + (while e + (setq typ (cdr (assoc 0 (entget e)))) + (setq blockname (cdr (assoc 2 (entget e)))) + (if + (and + (equal (cdr (assoc 5 (entget e))) ref) + (equal typ "INSERT") + (equal (cdr (assoc 66 (entget e))) 1) + ) + (progn + (einzel-attr-aendern bezeichnung wert addition) + (setq raus 1) ; rausspringen !!! + ) + ) + (setq e (entnext e)) + (if (= RAUS 1) + (setq e NIL) + ) + ) +) + +(defun einzel-attr-aendern (BEZEICHNUNG WERT ADDITION) + (while (not (= (cdr (assoc 0 (entget e))) "SEQEND")) + (setq typ (cdr (assoc 0 (entget e)))) + (if + (equal typ "ATTRIB") + (progn + (setq ATTRIBUT-BEZEICHNUNG (cdr (assoc 2 (entget e)))) + (setq ATTRIBUT-WERT (cdr (assoc 1 (entget e)))) + (if (= ADDITION 0) ; Attributwert GANZ ersetzen + (progn + (if (equal ATTRIBUT-BEZEICHNUNG BEZEICHNUNG) + (entmod (subst (cons 1 WERT) + (assoc 1 (entget e)) (entget e))) + ) + ) + ) + (if (= ADDITION 1) ; Attributwert ERGAENZEN + (progn + (if (equal ATTRIBUT-BEZEICHNUNG BEZEICHNUNG) + (entmod (subst (cons 1 (strcat ATTRIBUT-WERT WERT)) + (assoc 1 (entget e)) (entget e))) + ) + ) + ) + + ) ; Ende ----progn + ) + (setq e (entnext e)) + ) +) +;-------------------------------------------------------------------------- +(setq lw "m:") +(setvar "attreq" 0) +(setq + v-lay (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10") + v-col (list "7" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10") + v-ltyp (list "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" ) +) +;---------------------------------------------------------------------------- +(prompt "\nSSG-Menu.. (c) 2013 by SCHNENBERGER Systeme GmbH - All rights reserved") +(prompt " ") +(princ) diff --git a/doc/acadsst/MENU/ssg_110617.lsp b/doc/acadsst/MENU/ssg_110617.lsp new file mode 100644 index 0000000..ac46b3b --- /dev/null +++ b/doc/acadsst/MENU/ssg_110617.lsp @@ -0,0 +1,515 @@ +(IF SPECIAL + (SPECIAL '(olde ptest cavar bell prna)) + (DEFUN SPECIAL (x) nil) +) +(DEFUN pstart (tit qust setv / xlen xpos xvar) + (SETQ olde *ERROR* + *ERROR* (IF ptest NIL errhan) + cavar (APPEND '(("CLAYER")("CMDECHO")) + setv) + xlen (LENGTH cavar) + xpos 0 + ) + (REPEAT xlen + (SETQ xvar (CAR (NTH xpos cavar)) + cavar (SUBST (CONS xvar (GETVAR xvar)) + (NTH xpos cavar) cavar) + xpos (1+ xpos) + ) + ) + (SETVAR "CMDECHO" 0) + (COMMAND "_undo" "_G") + (GRAPHSCR) + (PROMPT (STRCAT "\n***** " tit " *****\n\n " qust)) + (PRINC) +) +(DEFUN pend (/ xpos xlen xvar) + (IF cavar + (PROGN + (COMMAND) + (COMMAND "_undo" "_E") + (SETQ xpos 1 + xlen (LENGTH cavar) + ) + (IF (/= (GETVAR "CLAYER") (CAAR cavar)) + (COMMAND "_LAYER" "_SE" (CDAR CAVAR) "") + ) + (REPEAT (1- xlen) + (SETQ xvar (NTH xpos cavar) + xpos (1+ xpos) + ) + (SETVAR (CAR xvar)(CDR xvar)) + ) + ) + ) + (IF olde (SETQ *ERROR* olde)) + (PRINC) +) +(DEFUN errhan (em) + (IF (= em "Function cancelled") + (PRINC) + (PRINC em) + ) + (GRTEXT) + (COMMAND) + (COMMAND) + (pend) +) +(DEFUN ques (dial defa) ;Std Abfrage + (IF defa + (PROGN + (INITGET 1 "Yes No Yes") + (= (GETKWORD (STRCAT "\n" dial " Y/N : ")) "No") + ) + (PROGN + (INITGET 1 "Yes No No") + (= (GETKWORD (STRCAT "\n" dial " Y/N : ")) "Yes") + ) + ) +) +(DEFUN emsg (etxt) + (IF (NOT bell)(PROMPT "\007")) + (TERPRI) + (PROMPT etxt) + (TERPRI) +) +(DEFUN ques (dial defa) ;Std Abfrage + (IF defa + (PROGN + (INITGET 1 "Yes No Yes") + (= (GETKWORD (STRCAT "\n" dial " Y/N : ")) "No") + ) + (PROGN + (INITGET 1 "Yes No No") + (= (GETKWORD (STRCAT "\n" dial " Y/N : ")) "Yes") + ) + ) +) +(DEFUN renv (envn prnn / penv) + (IF (SETQ penv (GETENV envn)) + (EVAL (STRCAT penv "" prnn)) + (EVAL prnn) + ) +) +(DEFUN C:PRG (/ nprg cprg prna) + (SETQ nprg (GETSTRING) + cprg (STRCAT "C:" nprg) + prna (renv "ACADLSP" nprg) + ) + (IF (NULL (EVAL (READ cprg))) + (PROGN + (PRINC " loading...!\n") + (COND + ((FINDFILE (STRCAT prna ".BI4")) + (LOAD prna ".BI4")) + ((FINDFILE (STRCAT prna ".BI2")) + (LOAD prna ".BI2")) + ((FINDFILE (STRCAT prna ".LSP")) + (LOAD prna ".LSP")) + ( T (emsg "File not found")) + ) + ) + ) + (PRINC) +) +(DEFUN C:ed (/ prnn) + (IF (NULL prna) + (SETQ prna "") + ) + (SETQ prnn (GETSTRING + (STRCAT "Programname <" prna ">: "))) + (IF (AND (= (STRLEN prna) 0)(= (STRLEN prnn) 0)) + (emsg "Name not allowed...") + (PROGN + (IF (> (STRLEN prnn) 0) + (SETQ prna (renv "ACADLSP" prnn)) + ) + (COMMAND "SHELL" (STRCAT "ED " prna )) + (INITGET 1 "Yes No Yes") + (IF (NOT (ques "Load the program" T)) + (LOAD prna) + ) + ) + ) + (PRINC) +) +;----------- Block einfuegen mit Layergenerierung ----2.8.92 AW +; KEINE DREHMOEGLICHKEIT !!! +(DEFUN c:symplac ( / einp); / einp ebene symname) + (SETQ einp (GETPOINT "\nInsert-Point: ")) + (COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "") + (COMMAND "_insert" symname einp "" "" "0") +) +;----------- Block einfuegen mit Layergenerierung ----14.8.92 AW +; MIT DREHMOEGLICHKEIT !!! +(DEFUN c:sympl_dr ( / einp); / einp ebene symname) + (SETQ einp (GETPOINT "\nInsert-Point: ")) + (COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "") + (COMMAND "_insert" symname einp "" "" pause) +) +;----------- Block einfuegen mit Layergenerierung ---16.9.93 AW +; MIT DREHMOEGLICHKEIT UND URSPRUNG NACH DEM SETZEN !!! +(DEFUN c:sympldr2 ( / einp drehung groesse) + (setq groesse "1") + (SETQ einp (GETPOINT "\nInsert-Point: ")) + (SETQ drehung (GETSTRING "\nRotation: ")) + (SETQ groesse (GETSTRING "\nScale: ")) + (COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "") + (COMMAND "_insert" symname einp groesse groesse drehung) + (COMMAND "_explode" "_last") +) +;----------- Block einfuegen mit Layergenerierung ---21.11.93 AW +; ABFRAGE: SKALIERUNG/ DREHMOEGLICHKEIT UND URSPRUNG NACH DEM SETZEN !!! +(DEFUN c:sympldr1 ( / einp drehung) + (SETQ einp (GETPOINT "\nInsert-Point: ")) + (SETQ drehung (GETSTRING "\nRotation: ")) + (COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "") + (COMMAND "_insert" symname einp "" "" drehung) + (COMMAND "_explode" "_last") +) +;----------- Block einfuegen mit Layergenerierung und Skalierung ---12.2.93 AW +(DEFUN c:sym_scal ( / einp p1 p2); / einp ebene symname) + (SETQ einp (GETPOINT "\nInsert-Point: ")) + (SETQ p1 (GETREAL "\nX-Scale: ")) + (SETQ p2 (GETREAL "\nY-Scale: ")) + (COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "") + (COMMAND "_insert" symname einp p1 p2 "0") +) + +;------------ Farbe aendern - AUFRUF aus POP2-------------------------- +(DEFUN c:alt_farb ( / sst_obj neuefarb) + (setq sst_obj (ssget) neuefarb (getstring "\nNew-Color: ")) + (command "_change" sst_obj "" "_prop" "_co" neuefarb "") +) +;-------------------------------------------------------------------- + +(defun block-op (PT0 szoeg auswahl-satz / komponente1 komponente2 + seconds element-name gefunden) + ;------------------ + ; Block definieren + ;----------------------------------------------------------- + ; PT0 - Origin der Baugruppe + ; szoeg - Einfuegewinkel + ; auswahl-satz - Elemente des Blockes in Auswahlsatz + ;------------------------------------------------------------ + (setq komponente1 (strcat (itoa (abs (fix (car PT0)))) (itoa (abs (fix (cadr PT0)))) + (itoa (abs (fix (caddr PT0)))))) + (setq komponente2 szoeg) + (setq seconds (substr (rtos (getvar "cdate") 2 9) 10 9)) + (setq element-name (strcat komponente1 komponente2 seconds)) + (princ) + (princ (strcat komponente1 "\n")) + (princ (strcat komponente2 "\n")) + (princ (strcat seconds "\n")) + (princ) + (princ (strcat "\n" element-name "\n")) + (princ) + (setq gefunden (tblsearch "block" element-name)) + (if (not gefunden) + (progn + (princ) + (command "_block" element-name PT0 auswahl-satz "") + (command "_insert" element-name PT0 "" "" szoeg) + ) + (progn + (alert (strcat "\nBlockname: " element-name " already exists." )) + (setq element-name (strcat "x" element-name)) + (alert (strcat "\nCorrected blockname: " element-name " .OK!")) + (command "_block" element-name PT0 auswahl-satz "") + (command "_insert" element-name PT0 "" "" szoeg) + ) + ) +) + +(defun bl-name (PT0 / komponente1 seconds) +; 14.4.94 +; Verwendung bei Baugruppen, deren Bestandteile aufgelistet +; werden mssen. +; Name eines Blockes gleich am Anfang des Programmes festlegen +; - die Einzelkomponenten werden in "C" mit diesem Wert belegt +; - dadurch ist eine eindeutige Gruppenzugeh"rigkeit m"glich +; + (setq komponente1 (strcat (itoa (abs (fix (car PT0)))) (itoa (abs (fix (cadr PT0)))) + (itoa (abs (fix (caddr PT0)))))) + (setq seconds (substr (rtos (getvar "cdate") 2 9) 10 9)) + (setq block-kennung (strcat komponente1 seconds)) + (princ) +) + +(defun mach-block-ohne-prop (PT0 szoeg auswahl-satz / komponente1 komponente2 + seconds element-name gefunden) + ;------------------ + ; Block definieren + ;----------------------------------------------------------- + ; PT0 - Origin der Baugruppe + ; szoeg - Einfuegewinkel + ; auswahl-satz - Elemente des Blockes in Auswahlsatz + ;------------------------------------------------------------ + (setq komponente1 (strcat (itoa (abs (fix (car PT0)))) (itoa (abs (fix (cadr PT0)))) + (itoa (abs (fix (caddr PT0)))))) + (setq komponente2 szoeg) + (setq seconds (substr (rtos (getvar "cdate") 2 9) 10 9)) + (setq element-name (strcat komponente1 komponente2 seconds)) + (princ) + (princ (strcat komponente1 "\n")) + (princ (strcat komponente2 "\n")) + (princ (strcat seconds "\n")) + (princ) + (princ (strcat "\n" element-name "\n")) + (princ) + (setq gefunden (tblsearch "block" element-name)) + (if (not gefunden) + (progn + (princ) + (command "_block" element-name PT0 auswahl-satz "") + (command "_insert" element-name PT0 "" "" szoeg) + ) + (alert "\nBlockname exists. You need HELP !") + ) +) + + +(defun mach-block (PT0 szoeg auswahl-satz / komponente1 komponente2 + seconds element-name gefunden) + ;------------------ + ; Block definieren + ;----------------------------------------------------------- + ; PT0 - Origin der Baugruppe + ; szoeg - Einfuegewinkel + ; auswahl-satz - Elemente des Blockes in Auswahlsatz + ;------------------------------------------------------------ + (setq komponente1 (strcat (itoa (abs (fix (car PT0)))) (itoa (abs (fix (cadr PT0)))) + (itoa (abs (fix (caddr PT0)))))) + (setq komponente2 szoeg) + (setq seconds (substr (rtos (getvar "cdate") 2 9) 10 9)) + (setq element-name (strcat komponente1 komponente2 seconds)) + (princ) + (princ (strcat komponente1 "\n")) + (princ (strcat komponente2 "\n")) + (princ (strcat seconds "\n")) + (princ) + (princ (strcat "\n" element-name "\n")) + (princ) + (setq gefunden (tblsearch "block" element-name)) + (if (not gefunden) + (progn + (princ) + (command "_insert" (strcat "*" lw "/acadsst/menu/a") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/b") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/c") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/artinr") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/beschr") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/menge") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/position") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/gruppe") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/etikette") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/aufloese") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_block" element-name PT0 auswahl-satz "") + (command "_insert" element-name PT0 "" "" szoeg) + ) + (alert "\nBlockname exists. You need HELP !") + ) +) + +;---------- Attribute aendern - Laenge,Endstueck,Artikel-Nr.-------------------- +(defun ATTRIBUTE-AENDERN (M_POSITION M_ETIKETTE M_GRUPPE M_A M_B M_C M_ARTINR + M_BESCHR M_MENGE M_AUFLOESE / objekt typ + attribut-bezeichnung attribut-wert) + (setq objekt (entlast)) + (while (not (equal + (cdr (assoc 0 (entget objekt))) + "SEQEND")) + (setq typ + (cdr (assoc 0 (entget objekt)))) + (if + (equal typ "ATTRIB") + (progn + (setq ATTRIBUT-BEZEICHNUNG (cdr (assoc 2 (entget objekt)))) + (setq ATTRIBUT-WERT (cdr (assoc 1 (entget objekt)))) + + (if (and (> (strlen M_POSITION) 0) (= ATTRIBUT-BEZEICHNUNG "POSITION")) + (entmod (subst (cons 1 M_POSITION) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_ETIKETTE) 0) (= ATTRIBUT-BEZEICHNUNG "ETIKETTE")) + (entmod (subst (cons 1 M_ETIKETTE) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_GRUPPE) 0) (= ATTRIBUT-BEZEICHNUNG "GRUPPE")) + (entmod (subst (cons 1 M_GRUPPE) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_A) 0) (equal ATTRIBUT-BEZEICHNUNG "A")) + (entmod (subst (cons 1 M_A) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_B) 0) (equal ATTRIBUT-BEZEICHNUNG "B")) + (entmod (subst (cons 1 M_B) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_C) 0) (equal ATTRIBUT-BEZEICHNUNG "C")) + (entmod (subst (cons 1 M_C) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_ARTINR) 0) (equal ATTRIBUT-BEZEICHNUNG "ARTINR")) + (entmod (subst (cons 1 M_ARTINR) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_BESCHR) 0) (equal ATTRIBUT-BEZEICHNUNG "BESCHR")) + (entmod (subst (cons 1 (strcat ATTRIBUT-WERT M_BESCHR)) + (assoc 1 (entget objekt)) (entget objekt))) + ) + (if (and (> (strlen M_MENGE) 0) (equal ATTRIBUT-BEZEICHNUNG "MENGE")) + (entmod (subst (cons 1 M_MENGE) + (assoc 1 (entget objekt)) (entget objekt))) + ) + (if (and (> (strlen M_AUFLOESE) 0) (equal ATTRIBUT-BEZEICHNUNG "AUFLOESE")) + (entmod (subst (cons 1 M_AUFLOESE) + (assoc 1 (entget objekt)) (entget objekt))) + ) + ) ; Ende ----progn + ) ; Ende ----if + (setq objekt (entnext objekt)) + ) + (setq objekt objekt) +) + +;---------- Attribute aendern - Laenge,Endstueck,Artikel-Nr.-------------------- +(defun ATTRIBUTE-AENDERN_IO (M_IO M_ID M_VERW M_BEZEICHNUNG M_KENNZEICHNUNG / objekt typ attribut-bezeichnung attribut-wert) + (setq objekt (entlast)) + (while (not (equal + (cdr (assoc 0 (entget objekt))) + "SEQEND")) + (setq typ + (cdr (assoc 0 (entget objekt)))) + (if + (equal typ "ATTRIB") + (progn + (setq ATTRIBUT-BEZEICHNUNG (cdr (assoc 2 (entget objekt)))) + (setq ATTRIBUT-WERT (cdr (assoc 1 (entget objekt)))) + + (if (and (> (strlen M_IO) 0) (= ATTRIBUT-BEZEICHNUNG "IO")) + (entmod (subst (cons 1 M_IO) (assoc 1 (entget objekt)) + (entget objekt))) + ) + + (if (and (> (strlen M_ID) 0) (= ATTRIBUT-BEZEICHNUNG "ID")) + (entmod (subst (cons 1 M_ID) (assoc 1 (entget objekt)) + (entget objekt))) + ) + + (if (and (> (strlen M_VERW) 0) (= ATTRIBUT-BEZEICHNUNG "VERW")) + (entmod (subst (cons 1 M_VERW) (assoc 1 (entget objekt)) + (entget objekt))) + ) + + (if (and (> (strlen M_BEZEICHNUNG) 0) (= ATTRIBUT-BEZEICHNUNG "BEZEICHNUNG")) + (entmod (subst (cons 1 M_BEZEICHNUNG) (assoc 1 (entget objekt)) + (entget objekt))) + ) + + (if (and (> (strlen M_KENNZEICHNUNG) 0) (= ATTRIBUT-BEZEICHNUNG "KENNZEICHNUNG")) + (entmod (subst (cons 1 M_KENNZEICHNUNG) (assoc 1 (entget objekt)) + (entget objekt))) + ) + + ) ; Ende ----progn + ) ; Ende ----if + + (setq objekt (entnext objekt)) + ) + (setq objekt objekt) +) + + +;--- Objekt in der DB suchen und Attribut "ndern --------------- +; Parameter: +; ref - handle +; bezeichnung - Attributbezeichnung, die gesucht ist +; wert - neuer Wert +; addition = 0 - Attributbezeichnung wird mit "wert" ersetzt +; 1 - Attributbezeichnung wird mit "wert" erg"nzt +;---------------------------------------------------------------- +(defun suchen-aendern ( ref bezeichnung wert addition + / typ attribut-bezeichnung attribut-wert) + (redraw (handent ref) 3) + (obj-suchen ref) + (redraw (handent ref)) +) + +(defun obj-suchen (ref) + (setq raus 0) + (setq e (entnext)) + (while e + (setq typ (cdr (assoc 0 (entget e)))) + (setq blockname (cdr (assoc 2 (entget e)))) + (if + (and + (equal (cdr (assoc 5 (entget e))) ref) + (equal typ "INSERT") + (equal (cdr (assoc 66 (entget e))) 1) + ) + (progn + (einzel-attr-aendern bezeichnung wert addition) + (setq raus 1) ; rausspringen !!! + ) + ) + (setq e (entnext e)) + (if (= RAUS 1) + (setq e NIL) + ) + ) +) + +(defun einzel-attr-aendern (BEZEICHNUNG WERT ADDITION) + (while (not (= (cdr (assoc 0 (entget e))) "SEQEND")) + (setq typ (cdr (assoc 0 (entget e)))) + (if + (equal typ "ATTRIB") + (progn + (setq ATTRIBUT-BEZEICHNUNG (cdr (assoc 2 (entget e)))) + (setq ATTRIBUT-WERT (cdr (assoc 1 (entget e)))) + (if (= ADDITION 0) ; Attributwert GANZ ersetzen + (progn + (if (equal ATTRIBUT-BEZEICHNUNG BEZEICHNUNG) + (entmod (subst (cons 1 WERT) + (assoc 1 (entget e)) (entget e))) + ) + ) + ) + (if (= ADDITION 1) ; Attributwert ERGAENZEN + (progn + (if (equal ATTRIBUT-BEZEICHNUNG BEZEICHNUNG) + (entmod (subst (cons 1 (strcat ATTRIBUT-WERT WERT)) + (assoc 1 (entget e)) (entget e))) + ) + ) + ) + + ) ; Ende ----progn + ) + (setq e (entnext e)) + ) +) +;-------------------------------------------------------------------------- +(setq lw "m:") +(setvar "attreq" 0) +(setq + v-lay (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10") + v-col (list "7" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10") + v-ltyp (list "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" ) +) +;---------------------------------------------------------------------------- +(prompt "\nSSG-Menu.. (c) 2007 by SCHNENBERGER Systeme GmbH - All rights reserved") +(prompt " ") +(princ) diff --git a/doc/acadsst/MENU/ssg_130829.lsp b/doc/acadsst/MENU/ssg_130829.lsp new file mode 100644 index 0000000..73739c8 --- /dev/null +++ b/doc/acadsst/MENU/ssg_130829.lsp @@ -0,0 +1,518 @@ +(IF SPECIAL + (SPECIAL '(olde ptest cavar bell prna)) + (DEFUN SPECIAL (x) nil) +) +(DEFUN pstart (tit qust setv / xlen xpos xvar) + (SETQ olde *ERROR* + *ERROR* (IF ptest NIL errhan) + cavar (APPEND '(("CLAYER")("CMDECHO")) + setv) + xlen (LENGTH cavar) + xpos 0 + ) + (REPEAT xlen + (SETQ xvar (CAR (NTH xpos cavar)) + cavar (SUBST (CONS xvar (GETVAR xvar)) + (NTH xpos cavar) cavar) + xpos (1+ xpos) + ) + ) + (SETVAR "CMDECHO" 0) + (COMMAND "_undo" "_G") + (GRAPHSCR) + (PROMPT (STRCAT "\n***** " tit " *****\n\n " qust)) + (PRINC) +) +(DEFUN pend (/ xpos xlen xvar) + (IF cavar + (PROGN + (COMMAND) + (COMMAND "_undo" "_E") + (SETQ xpos 1 + xlen (LENGTH cavar) + ) + (IF (/= (GETVAR "CLAYER") (CAAR cavar)) + (COMMAND "_LAYER" "_SE" (CDAR CAVAR) "") + ) + (REPEAT (1- xlen) + (SETQ xvar (NTH xpos cavar) + xpos (1+ xpos) + ) + (SETVAR (CAR xvar)(CDR xvar)) + ) + ) + ) + (IF olde (SETQ *ERROR* olde)) + (PRINC) +) +(DEFUN errhan (em) + (IF (= em "Function cancelled") + (PRINC) + (PRINC em) + ) + (GRTEXT) + (COMMAND) + (COMMAND) + (pend) +) +(DEFUN ques (dial defa) ;Std Abfrage + (IF defa + (PROGN + (INITGET 1 "Yes No Yes") + (= (GETKWORD (STRCAT "\n" dial " Y/N : ")) "No") + ) + (PROGN + (INITGET 1 "Yes No No") + (= (GETKWORD (STRCAT "\n" dial " Y/N : ")) "Yes") + ) + ) +) +(DEFUN emsg (etxt) + (IF (NOT bell)(PROMPT "\007")) + (TERPRI) + (PROMPT etxt) + (TERPRI) +) +(DEFUN ques (dial defa) ;Std Abfrage + (IF defa + (PROGN + (INITGET 1 "Yes No Yes") + (= (GETKWORD (STRCAT "\n" dial " Y/N : ")) "No") + ) + (PROGN + (INITGET 1 "Yes No No") + (= (GETKWORD (STRCAT "\n" dial " Y/N : ")) "Yes") + ) + ) +) +(DEFUN renv (envn prnn / penv) + (IF (SETQ penv (GETENV envn)) + (EVAL (STRCAT penv "" prnn)) + (EVAL prnn) + ) +) +(DEFUN C:PRG (/ nprg cprg prna) + (SETQ nprg (GETSTRING) + cprg (STRCAT "C:" nprg) + prna (renv "ACADLSP" nprg) + ) + (IF (NULL (EVAL (READ cprg))) + (PROGN + (PRINC " loading...!\n") + (COND + ((FINDFILE (STRCAT prna ".BI4")) + (LOAD prna ".BI4")) + ((FINDFILE (STRCAT prna ".BI2")) + (LOAD prna ".BI2")) + ((FINDFILE (STRCAT prna ".LSP")) + (LOAD prna ".LSP")) + ( T (emsg "File not found")) + ) + ) + ) + (PRINC) +) +(DEFUN C:ed (/ prnn) + (IF (NULL prna) + (SETQ prna "") + ) + (SETQ prnn (GETSTRING + (STRCAT "Programname <" prna ">: "))) + (IF (AND (= (STRLEN prna) 0)(= (STRLEN prnn) 0)) + (emsg "Name not allowed...") + (PROGN + (IF (> (STRLEN prnn) 0) + (SETQ prna (renv "ACADLSP" prnn)) + ) + (COMMAND "SHELL" (STRCAT "ED " prna )) + (INITGET 1 "Yes No Yes") + (IF (NOT (ques "Load the program" T)) + (LOAD prna) + ) + ) + ) + (PRINC) +) +;----------- Block einfuegen mit Layergenerierung ----2.8.92 AW +; KEINE DREHMOEGLICHKEIT !!! +(DEFUN c:symplac ( / einp); / einp ebene symname) + (SETQ einp (GETPOINT "\nInsert-Point: ")) + (COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "") + (COMMAND "_insert" symname einp "" "" "0") +) +;----------- Block einfuegen mit Layergenerierung ----14.8.92 AW +; MIT DREHMOEGLICHKEIT !!! +(DEFUN c:sympl_dr ( / einp); / einp ebene symname) + (SETQ einp (GETPOINT "\nInsert-Point: ")) + (COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "") + (COMMAND "_insert" symname einp "" "" pause) +) +;----------- Block einfuegen mit Layergenerierung ---16.9.93 AW +; MIT DREHMOEGLICHKEIT UND URSPRUNG NACH DEM SETZEN !!! +(DEFUN c:sympldr2 ( / einp drehung groesse) + (setq groesse "1") + (SETQ einp (GETPOINT "\nInsert-Point: ")) + (SETQ drehung (GETSTRING "\nRotation: ")) + (SETQ groesse (GETSTRING "\nScale: ")) + (COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "") + (COMMAND "_insert" symname einp groesse groesse drehung) + (COMMAND "_explode" "_last") +) +;----------- Block einfuegen mit Layergenerierung ---21.11.93 AW +; ABFRAGE: SKALIERUNG/ DREHMOEGLICHKEIT UND URSPRUNG NACH DEM SETZEN !!! +(DEFUN c:sympldr1 ( / einp drehung) + (SETQ einp (GETPOINT "\nInsert-Point: ")) + (SETQ drehung (GETSTRING "\nRotation: ")) + (COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "") + (COMMAND "_insert" symname einp "" "" drehung) + (COMMAND "_explode" "_last") +) +;----------- Block einfuegen mit Layergenerierung und Skalierung ---12.2.93 AW +(DEFUN c:sym_scal ( / einp p1 p2); / einp ebene symname) + (SETQ einp (GETPOINT "\nInsert-Point: ")) + (SETQ p1 (GETREAL "\nX-Scale: ")) + (SETQ p2 (GETREAL "\nY-Scale: ")) + (COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "") + (COMMAND "_insert" symname einp p1 p2 "0") +) + +;------------ Farbe aendern - AUFRUF aus POP2-------------------------- +(DEFUN c:alt_farb ( / sst_obj neuefarb) + (setq sst_obj (ssget) neuefarb (getstring "\nNew-Color: ")) + (command "_change" sst_obj "" "_prop" "_co" neuefarb "") +) +;-------------------------------------------------------------------- + +(defun block-op (PT0 szoeg auswahl-satz / komponente1 komponente2 + seconds element-name gefunden) + ;------------------ + ; Block definieren + ;----------------------------------------------------------- + ; PT0 - Origin der Baugruppe + ; szoeg - Einfuegewinkel + ; auswahl-satz - Elemente des Blockes in Auswahlsatz + ;------------------------------------------------------------ + (setq komponente1 (strcat (itoa (abs (fix (car PT0)))) (itoa (abs (fix (cadr PT0)))) + (itoa (abs (fix (caddr PT0)))))) + (setq komponente2 szoeg) + (setq seconds (substr (rtos (getvar "cdate") 2 9) 10 9)) + (setq element-name (strcat komponente1 komponente2 seconds)) + (princ) + (princ (strcat komponente1 "\n")) + (princ (strcat komponente2 "\n")) + (princ (strcat seconds "\n")) + (princ) + (princ (strcat "\n" element-name "\n")) + (princ) + (setq gefunden (tblsearch "block" element-name)) + (if (not gefunden) + (progn + (princ) + (command "_block" element-name PT0 auswahl-satz "") + (command "_insert" element-name PT0 "" "" szoeg) + ) + (progn + (alert (strcat "\nBlockname: " element-name " already exists." )) + (setq element-name (strcat "x" element-name)) + (alert (strcat "\nCorrected blockname: " element-name " .OK!")) + (command "_block" element-name PT0 auswahl-satz "") + (command "_insert" element-name PT0 "" "" szoeg) + ) + ) +) + +(defun bl-name (PT0 / komponente1 seconds) +; 14.4.94 +; Verwendung bei Baugruppen, deren Bestandteile aufgelistet +; werden mssen. +; Name eines Blockes gleich am Anfang des Programmes festlegen +; - die Einzelkomponenten werden in "C" mit diesem Wert belegt +; - dadurch ist eine eindeutige Gruppenzugeh"rigkeit m"glich +; + (setq komponente1 (strcat (itoa (abs (fix (car PT0)))) (itoa (abs (fix (cadr PT0)))) + (itoa (abs (fix (caddr PT0)))))) + (setq seconds (substr (rtos (getvar "cdate") 2 9) 10 9)) + (setq block-kennung (strcat komponente1 seconds)) + (princ) +) + +(defun mach-block-ohne-prop (PT0 szoeg auswahl-satz / komponente1 komponente2 + seconds element-name gefunden) + ;------------------ + ; Block definieren + ;----------------------------------------------------------- + ; PT0 - Origin der Baugruppe + ; szoeg - Einfuegewinkel + ; auswahl-satz - Elemente des Blockes in Auswahlsatz + ;------------------------------------------------------------ + (setq komponente1 (strcat (itoa (abs (fix (car PT0)))) (itoa (abs (fix (cadr PT0)))) + (itoa (abs (fix (caddr PT0)))))) + (setq komponente2 szoeg) + (setq seconds (substr (rtos (getvar "cdate") 2 9) 10 9)) + (setq element-name (strcat komponente1 komponente2 seconds)) + (princ) + (princ (strcat komponente1 "\n")) + (princ (strcat komponente2 "\n")) + (princ (strcat seconds "\n")) + (princ) + (princ (strcat "\n" element-name "\n")) + (princ) + (setq gefunden (tblsearch "block" element-name)) + (if (not gefunden) + (progn + (princ) + (command "_block" element-name PT0 auswahl-satz "") + (command "_insert" element-name PT0 "" "" szoeg) + ) + (alert "\nBlockname exists. You need HELP !") + ) +) + + +(defun mach-block (PT0 szoeg auswahl-satz / komponente1 komponente2 + seconds element-name gefunden) + ;------------------ + ; Block definieren + ;----------------------------------------------------------- + ; PT0 - Origin der Baugruppe + ; szoeg - Einfuegewinkel + ; auswahl-satz - Elemente des Blockes in Auswahlsatz + ;------------------------------------------------------------ + (setq komponente1 (strcat (itoa (abs (fix (car PT0)))) (itoa (abs (fix (cadr PT0)))) + (itoa (abs (fix (caddr PT0)))))) + (setq komponente2 szoeg) + (setq seconds (substr (rtos (getvar "cdate") 2 9) 10 9)) + (setq element-name (strcat komponente1 komponente2 seconds)) + (princ) + (princ (strcat komponente1 "\n")) + (princ (strcat komponente2 "\n")) + (princ (strcat seconds "\n")) + (princ) + (princ (strcat "\n" element-name "\n")) + (princ) + (setq gefunden (tblsearch "block" element-name)) + (if (not gefunden) + (progn + (princ) + (command "_insert" (strcat "*" lw "/acadsst/menu/a") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/b") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/c") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/artinr") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/beschr") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/menge") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/position") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/gruppe") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/etikette") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/aufloese") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_block" element-name PT0 auswahl-satz "") + (command "_insert" element-name PT0 "" "" szoeg) + ) + (alert "\nBlockname exists. You need HELP !") + ) +) + +;---------- Attribute aendern - Laenge,Endstueck,Artikel-Nr.-------------------- +(defun ATTRIBUTE-AENDERN (M_POSITION M_ETIKETTE M_GRUPPE M_A M_B M_C M_ARTINR + M_BESCHR M_MENGE M_AUFLOESE / objekt typ + attribut-bezeichnung attribut-wert) + (setq objekt (entlast)) + (while (not (equal + (cdr (assoc 0 (entget objekt))) + "SEQEND")) + (setq typ + (cdr (assoc 0 (entget objekt)))) + (if + (equal typ "ATTRIB") + (progn + (setq ATTRIBUT-BEZEICHNUNG (cdr (assoc 2 (entget objekt)))) + (setq ATTRIBUT-WERT (cdr (assoc 1 (entget objekt)))) + + (if (and (> (strlen M_POSITION) 0) (= ATTRIBUT-BEZEICHNUNG "POSITION")) + (entmod (subst (cons 1 M_POSITION) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_ETIKETTE) 0) (= ATTRIBUT-BEZEICHNUNG "ETIKETTE")) + (entmod (subst (cons 1 M_ETIKETTE) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_GRUPPE) 0) (= ATTRIBUT-BEZEICHNUNG "GRUPPE")) + (entmod (subst (cons 1 M_GRUPPE) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_A) 0) (equal ATTRIBUT-BEZEICHNUNG "A")) + (entmod (subst (cons 1 M_A) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_B) 0) (equal ATTRIBUT-BEZEICHNUNG "B")) + (entmod (subst (cons 1 M_B) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_C) 0) (equal ATTRIBUT-BEZEICHNUNG "C")) + (entmod (subst (cons 1 M_C) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_ARTINR) 0) (equal ATTRIBUT-BEZEICHNUNG "ARTINR")) + (entmod (subst (cons 1 M_ARTINR) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_BESCHR) 0) (equal ATTRIBUT-BEZEICHNUNG "BESCHR")) + (entmod (subst (cons 1 (strcat ATTRIBUT-WERT M_BESCHR)) + (assoc 1 (entget objekt)) (entget objekt))) + ) + (if (and (> (strlen M_MENGE) 0) (equal ATTRIBUT-BEZEICHNUNG "MENGE")) + (entmod (subst (cons 1 M_MENGE) + (assoc 1 (entget objekt)) (entget objekt))) + ) + (if (and (> (strlen M_AUFLOESE) 0) (equal ATTRIBUT-BEZEICHNUNG "AUFLOESE")) + (entmod (subst (cons 1 M_AUFLOESE) + (assoc 1 (entget objekt)) (entget objekt))) + ) + ) ; Ende ----progn + ) ; Ende ----if + (setq objekt (entnext objekt)) + ) + (setq objekt objekt) +) + +;---------- Attribute aendern - Laenge,Endstueck,Artikel-Nr.-------------------- +(defun ATTRIBUTE-AENDERN_IO (M_IO M_ID M_VERW M_BEZEICHNUNG M_KENNZEICHNUNG M_SPS / objekt typ attribut-bezeichnung attribut-wert) + (setq objekt (entlast)) + (while (not (equal + (cdr (assoc 0 (entget objekt))) + "SEQEND")) + (setq typ + (cdr (assoc 0 (entget objekt)))) + (if + (equal typ "ATTRIB") + (progn + (setq ATTRIBUT-BEZEICHNUNG (cdr (assoc 2 (entget objekt)))) + (setq ATTRIBUT-WERT (cdr (assoc 1 (entget objekt)))) + + (if (and (> (strlen M_IO) 0) (= ATTRIBUT-BEZEICHNUNG "IO")) + (entmod (subst (cons 1 M_IO) (assoc 1 (entget objekt)) + (entget objekt))) + ) + + (if (and (> (strlen M_ID) 0) (= ATTRIBUT-BEZEICHNUNG "ID")) + (entmod (subst (cons 1 M_ID) (assoc 1 (entget objekt)) + (entget objekt))) + ) + + (if (and (> (strlen M_VERW) 0) (= ATTRIBUT-BEZEICHNUNG "VERW")) + (entmod (subst (cons 1 M_VERW) (assoc 1 (entget objekt)) + (entget objekt))) + ) + + (if (and (> (strlen M_BEZEICHNUNG) 0) (= ATTRIBUT-BEZEICHNUNG "BEZEICHNUNG")) + (entmod (subst (cons 1 M_BEZEICHNUNG) (assoc 1 (entget objekt)) + (entget objekt))) + ) + + (if (and (> (strlen M_KENNZEICHNUNG) 0) (= ATTRIBUT-BEZEICHNUNG "KENNZEICHNUNG")) + (entmod (subst (cons 1 M_KENNZEICHNUNG) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_SPS) 0) (= ATTRIBUT-BEZEICHNUNG "SPS")) + (entmod (subst (cons 1 M_SPS) (assoc 1 (entget objekt)) + (entget objekt))) + ) + ) ; Ende ----progn + ) ; Ende ----if + + (setq objekt (entnext objekt)) + ) + (setq objekt objekt) +) + + +;--- Objekt in der DB suchen und Attribut "ndern --------------- +; Parameter: +; ref - handle +; bezeichnung - Attributbezeichnung, die gesucht ist +; wert - neuer Wert +; addition = 0 - Attributbezeichnung wird mit "wert" ersetzt +; 1 - Attributbezeichnung wird mit "wert" erg"nzt +;---------------------------------------------------------------- +(defun suchen-aendern ( ref bezeichnung wert addition + / typ attribut-bezeichnung attribut-wert) + (redraw (handent ref) 3) + (obj-suchen ref) + (redraw (handent ref)) +) + +(defun obj-suchen (ref) + (setq raus 0) + (setq e (entnext)) + (while e + (setq typ (cdr (assoc 0 (entget e)))) + (setq blockname (cdr (assoc 2 (entget e)))) + (if + (and + (equal (cdr (assoc 5 (entget e))) ref) + (equal typ "INSERT") + (equal (cdr (assoc 66 (entget e))) 1) + ) + (progn + (einzel-attr-aendern bezeichnung wert addition) + (setq raus 1) ; rausspringen !!! + ) + ) + (setq e (entnext e)) + (if (= RAUS 1) + (setq e NIL) + ) + ) +) + +(defun einzel-attr-aendern (BEZEICHNUNG WERT ADDITION) + (while (not (= (cdr (assoc 0 (entget e))) "SEQEND")) + (setq typ (cdr (assoc 0 (entget e)))) + (if + (equal typ "ATTRIB") + (progn + (setq ATTRIBUT-BEZEICHNUNG (cdr (assoc 2 (entget e)))) + (setq ATTRIBUT-WERT (cdr (assoc 1 (entget e)))) + (if (= ADDITION 0) ; Attributwert GANZ ersetzen + (progn + (if (equal ATTRIBUT-BEZEICHNUNG BEZEICHNUNG) + (entmod (subst (cons 1 WERT) + (assoc 1 (entget e)) (entget e))) + ) + ) + ) + (if (= ADDITION 1) ; Attributwert ERGAENZEN + (progn + (if (equal ATTRIBUT-BEZEICHNUNG BEZEICHNUNG) + (entmod (subst (cons 1 (strcat ATTRIBUT-WERT WERT)) + (assoc 1 (entget e)) (entget e))) + ) + ) + ) + + ) ; Ende ----progn + ) + (setq e (entnext e)) + ) +) +;-------------------------------------------------------------------------- +(setq lw "D:") +(setvar "attreq" 0) +(setq + v-lay (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10") + v-col (list "7" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10") + v-ltyp (list "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" ) +) +;---------------------------------------------------------------------------- +(prompt "\nSSG-Menu.. (c) 2011 by SCHNENBERGER Systeme GmbH - All rights reserved") +(prompt " ") +(princ) diff --git a/doc/acadsst/MENU/ssg_old.lsp b/doc/acadsst/MENU/ssg_old.lsp new file mode 100644 index 0000000..9018e46 --- /dev/null +++ b/doc/acadsst/MENU/ssg_old.lsp @@ -0,0 +1,434 @@ +(IF SPECIAL + (SPECIAL '(olde ptest cavar bell prna)) + (DEFUN SPECIAL (x) nil) +) +(DEFUN pstart (tit qust setv / xlen xpos xvar) + (SETQ olde *ERROR* + *ERROR* (IF ptest NIL errhan) + cavar (APPEND '(("CLAYER")("CMDECHO")) + setv) + xlen (LENGTH cavar) + xpos 0 + ) + (REPEAT xlen + (SETQ xvar (CAR (NTH xpos cavar)) + cavar (SUBST (CONS xvar (GETVAR xvar)) + (NTH xpos cavar) cavar) + xpos (1+ xpos) + ) + ) + (SETVAR "CMDECHO" 0) + (COMMAND "_undo" "_G") + (GRAPHSCR) + (PROMPT (STRCAT "\n***** " tit " *****\n\n " qust)) + (PRINC) +) +(DEFUN pend (/ xpos xlen xvar) + (IF cavar + (PROGN + (COMMAND) + (COMMAND "_undo" "_E") + (SETQ xpos 1 + xlen (LENGTH cavar) + ) + (IF (/= (GETVAR "CLAYER") (CAAR cavar)) + (COMMAND "_LAYER" "_SE" (CDAR CAVAR) "") + ) + (REPEAT (1- xlen) + (SETQ xvar (NTH xpos cavar) + xpos (1+ xpos) + ) + (SETVAR (CAR xvar)(CDR xvar)) + ) + ) + ) + (IF olde (SETQ *ERROR* olde)) + (PRINC) +) +(DEFUN errhan (em) + (IF (= em "Function cancelled") + (PRINC) + (PRINC em) + ) + (GRTEXT) + (COMMAND) + (COMMAND) + (pend) +) +(DEFUN ques (dial defa) ;Std Abfrage + (IF defa + (PROGN + (INITGET 1 "Yes No Yes") + (= (GETKWORD (STRCAT "\n" dial " Y/N : ")) "No") + ) + (PROGN + (INITGET 1 "Yes No No") + (= (GETKWORD (STRCAT "\n" dial " Y/N : ")) "Yes") + ) + ) +) +(DEFUN emsg (etxt) + (IF (NOT bell)(PROMPT "\007")) + (TERPRI) + (PROMPT etxt) + (TERPRI) +) +(DEFUN ques (dial defa) ;Std Abfrage + (IF defa + (PROGN + (INITGET 1 "Yes No Yes") + (= (GETKWORD (STRCAT "\n" dial " Y/N : ")) "No") + ) + (PROGN + (INITGET 1 "Yes No No") + (= (GETKWORD (STRCAT "\n" dial " Y/N : ")) "Yes") + ) + ) +) +(DEFUN renv (envn prnn / penv) + (IF (SETQ penv (GETENV envn)) + (EVAL (STRCAT penv "" prnn)) + (EVAL prnn) + ) +) +(DEFUN C:PRG (/ nprg cprg prna) + (SETQ nprg (GETSTRING) + cprg (STRCAT "C:" nprg) + prna (renv "ACADLSP" nprg) + ) + (IF (NULL (EVAL (READ cprg))) + (PROGN + (PRINC " loading...!\n") + (COND + ((FINDFILE (STRCAT prna ".BI4")) + (LOAD prna ".BI4")) + ((FINDFILE (STRCAT prna ".BI2")) + (LOAD prna ".BI2")) + ((FINDFILE (STRCAT prna ".LSP")) + (LOAD prna ".LSP")) + ( T (emsg "File not found")) + ) + ) + ) + (PRINC) +) +(DEFUN C:ed (/ prnn) + (IF (NULL prna) + (SETQ prna "") + ) + (SETQ prnn (GETSTRING + (STRCAT "Programname <" prna ">: "))) + (IF (AND (= (STRLEN prna) 0)(= (STRLEN prnn) 0)) + (emsg "Name not allowed...") + (PROGN + (IF (> (STRLEN prnn) 0) + (SETQ prna (renv "ACADLSP" prnn)) + ) + (COMMAND "SHELL" (STRCAT "ED " prna )) + (INITGET 1 "Yes No Yes") + (IF (NOT (ques "Load the program" T)) + (LOAD prna) + ) + ) + ) + (PRINC) +) +;----------- Block einfuegen mit Layergenerierung ----2.8.92 AW +; KEINE DREHMOEGLICHKEIT !!! +(DEFUN c:symplac ( / einp); / einp ebene symname) + (SETQ einp (GETPOINT "\nInsert-Point: ")) + (COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "") + (COMMAND "_insert" symname einp "" "" "0") +) +;----------- Block einfuegen mit Layergenerierung ----14.8.92 AW +; MIT DREHMOEGLICHKEIT !!! +(DEFUN c:sympl_dr ( / einp); / einp ebene symname) + (SETQ einp (GETPOINT "\nInsert-Point: ")) + (COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "") + (COMMAND "_insert" symname einp "" "" pause) +) +;----------- Block einfuegen mit Layergenerierung ---16.9.93 AW +; MIT DREHMOEGLICHKEIT UND URSPRUNG NACH DEM SETZEN !!! +(DEFUN c:sympldr2 ( / einp drehung groesse) + (setq groesse "1") + (SETQ einp (GETPOINT "\nInsert-Point: ")) + (SETQ drehung (GETSTRING "\nRotation: ")) + (SETQ groesse (GETSTRING "\nScale: ")) + (COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "") + (COMMAND "_insert" symname einp groesse groesse drehung) + (COMMAND "_explode" "_last") +) +;----------- Block einfuegen mit Layergenerierung ---21.11.93 AW +; ABFRAGE: SKALIERUNG/ DREHMOEGLICHKEIT UND URSPRUNG NACH DEM SETZEN !!! +(DEFUN c:sympldr1 ( / einp drehung) + (SETQ einp (GETPOINT "\nInsert-Point: ")) + (SETQ drehung (GETSTRING "\nRotation: ")) + (COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "") + (COMMAND "_insert" symname einp "" "" drehung) + (COMMAND "_explode" "_last") +) +;----------- Block einfuegen mit Layergenerierung und Skalierung ---12.2.93 AW +(DEFUN c:sym_scal ( / einp p1 p2); / einp ebene symname) + (SETQ einp (GETPOINT "\nInsert-Point: ")) + (SETQ p1 (GETREAL "\nX-Scale: ")) + (SETQ p2 (GETREAL "\nY-Scale: ")) + (COMMAND "_LAYER" "_M" ebene "_co" eb_farbe "" "") + (COMMAND "_insert" symname einp p1 p2 "0") +) + +;------------ Farbe aendern - AUFRUF aus POP2-------------------------- +(DEFUN c:alt_farb ( / sst_obj neuefarb) + (setq sst_obj (ssget) neuefarb (getstring "\nNew-Color: ")) + (command "_change" sst_obj "" "_prop" "_co" neuefarb "") +) +;-------------------------------------------------------------------- + +(defun block-op (PT0 szoeg auswahl-satz / komponente1 komponente2 + seconds element-name gefunden) + ;------------------ + ; Block definieren + ;----------------------------------------------------------- + ; PT0 - Origin der Baugruppe + ; szoeg - Einfuegewinkel + ; auswahl-satz - Elemente des Blockes in Auswahlsatz + ;------------------------------------------------------------ + (setq komponente1 (strcat (itoa (abs (fix (car PT0)))) (itoa (abs (fix (cadr PT0)))) + (itoa (abs (fix (caddr PT0)))))) + (setq komponente2 szoeg) + (setq seconds (substr (rtos (getvar "cdate") 2 9) 10 9)) + (setq element-name (strcat komponente1 komponente2 seconds)) + (princ) + (princ (strcat komponente1 "\n")) + (princ (strcat komponente2 "\n")) + (princ (strcat seconds "\n")) + (princ) + (princ (strcat "\n" element-name "\n")) + (princ) + (setq gefunden (tblsearch "block" element-name)) + (if (not gefunden) + (progn + (princ) + (command "_block" element-name PT0 auswahl-satz "") + (command "_insert" element-name PT0 "" "" szoeg) + ) + (progn + (alert (strcat "\nBlockname: " element-name " already exists." )) + (setq element-name (strcat "x" element-name)) + (alert (strcat "\nCorrected blockname: " element-name " .OK!")) + (command "_block" element-name PT0 auswahl-satz "") + (command "_insert" element-name PT0 "" "" szoeg) + ) + ) +) + +(defun bl-name (PT0 / komponente1 seconds) +; 14.4.94 +; Verwendung bei Baugruppen, deren Bestandteile aufgelistet +; werden mssen. +; Name eines Blockes gleich am Anfang des Programmes festlegen +; - die Einzelkomponenten werden in "C" mit diesem Wert belegt +; - dadurch ist eine eindeutige Gruppenzugeh"rigkeit m"glich +; + (setq komponente1 (strcat (itoa (abs (fix (car PT0)))) (itoa (abs (fix (cadr PT0)))) + (itoa (abs (fix (caddr PT0)))))) + (setq seconds (substr (rtos (getvar "cdate") 2 9) 10 9)) + (setq block-kennung (strcat komponente1 seconds)) + (princ) +) + +(defun mach-block (PT0 szoeg auswahl-satz / komponente1 komponente2 + seconds element-name gefunden) + ;------------------ + ; Block definieren + ;----------------------------------------------------------- + ; PT0 - Origin der Baugruppe + ; szoeg - Einfuegewinkel + ; auswahl-satz - Elemente des Blockes in Auswahlsatz + ;------------------------------------------------------------ + (setq komponente1 (strcat (itoa (abs (fix (car PT0)))) (itoa (abs (fix (cadr PT0)))) + (itoa (abs (fix (caddr PT0)))))) + (setq komponente2 szoeg) + (setq seconds (substr (rtos (getvar "cdate") 2 9) 10 9)) + (setq element-name (strcat komponente1 komponente2 seconds)) + (princ) + (princ (strcat komponente1 "\n")) + (princ (strcat komponente2 "\n")) + (princ (strcat seconds "\n")) + (princ) + (princ (strcat "\n" element-name "\n")) + (princ) + (setq gefunden (tblsearch "block" element-name)) + (if (not gefunden) + (progn + (princ) + (command "_insert" (strcat "*" lw "/acadsst/menu/a") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/b") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/c") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/artinr") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/beschr") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/menge") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/position") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/gruppe") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/etikette") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat "*" lw "/acadsst/menu/aufloese") PT0 "" "") + (ssadd (entlast) auswahl-satz) + (command "_block" element-name PT0 auswahl-satz "") + (command "_insert" element-name PT0 "" "" szoeg) + ) + (alert "\nBlockname exists. You need HELP !") + ) +) + +;---------- Attribute aendern - Laenge,Endstueck,Artikel-Nr.-------------------- +(defun ATTRIBUTE-AENDERN (M_POSITION M_ETIKETTE M_GRUPPE M_A M_B M_C M_ARTINR + M_BESCHR M_MENGE M_AUFLOESE / objekt typ + attribut-bezeichnung attribut-wert) + (setq objekt (entlast)) + (while (not (equal + (cdr (assoc 0 (entget objekt))) + "SEQEND")) + (setq typ + (cdr (assoc 0 (entget objekt)))) + (if + (equal typ "ATTRIB") + (progn + (setq ATTRIBUT-BEZEICHNUNG (cdr (assoc 2 (entget objekt)))) + (setq ATTRIBUT-WERT (cdr (assoc 1 (entget objekt)))) + + (if (and (> (strlen M_POSITION) 0) (= ATTRIBUT-BEZEICHNUNG "POSITION")) + (entmod (subst (cons 1 M_POSITION) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_ETIKETTE) 0) (= ATTRIBUT-BEZEICHNUNG "ETIKETTE")) + (entmod (subst (cons 1 M_ETIKETTE) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_GRUPPE) 0) (= ATTRIBUT-BEZEICHNUNG "GRUPPE")) + (entmod (subst (cons 1 M_GRUPPE) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_A) 0) (equal ATTRIBUT-BEZEICHNUNG "A")) + (entmod (subst (cons 1 M_A) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_B) 0) (equal ATTRIBUT-BEZEICHNUNG "B")) + (entmod (subst (cons 1 M_B) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_C) 0) (equal ATTRIBUT-BEZEICHNUNG "C")) + (entmod (subst (cons 1 M_C) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_ARTINR) 0) (equal ATTRIBUT-BEZEICHNUNG "ARTINR")) + (entmod (subst (cons 1 M_ARTINR) (assoc 1 (entget objekt)) + (entget objekt))) + ) + (if (and (> (strlen M_BESCHR) 0) (equal ATTRIBUT-BEZEICHNUNG "BESCHR")) + (entmod (subst (cons 1 (strcat ATTRIBUT-WERT M_BESCHR)) + (assoc 1 (entget objekt)) (entget objekt))) + ) + (if (and (> (strlen M_MENGE) 0) (equal ATTRIBUT-BEZEICHNUNG "MENGE")) + (entmod (subst (cons 1 M_MENGE) + (assoc 1 (entget objekt)) (entget objekt))) + ) + (if (and (> (strlen M_AUFLOESE) 0) (equal ATTRIBUT-BEZEICHNUNG "AUFLOESE")) + (entmod (subst (cons 1 M_AUFLOESE) + (assoc 1 (entget objekt)) (entget objekt))) + ) + ) ; Ende ----progn + ) ; Ende ----if + (setq objekt (entnext objekt)) + ) + (setq objekt objekt) +) + +;--- Objekt in der DB suchen und Attribut "ndern --------------- +; Parameter: +; ref - handle +; bezeichnung - Attributbezeichnung, die gesucht ist +; wert - neuer Wert +; addition = 0 - Attributbezeichnung wird mit "wert" ersetzt +; 1 - Attributbezeichnung wird mit "wert" erg"nzt +;---------------------------------------------------------------- +(defun suchen-aendern ( ref bezeichnung wert addition + / typ attribut-bezeichnung attribut-wert) + (redraw (handent ref) 3) + (obj-suchen ref) + (redraw (handent ref)) +) + +(defun obj-suchen (ref) + (setq raus 0) + (setq e (entnext)) + (while e + (setq typ (cdr (assoc 0 (entget e)))) + (setq blockname (cdr (assoc 2 (entget e)))) + (if + (and + (equal (cdr (assoc 5 (entget e))) ref) + (equal typ "INSERT") + (equal (cdr (assoc 66 (entget e))) 1) + ) + (progn + (einzel-attr-aendern bezeichnung wert addition) + (setq raus 1) ; rausspringen !!! + ) + ) + (setq e (entnext e)) + (if (= RAUS 1) + (setq e NIL) + ) + ) +) + +(defun einzel-attr-aendern (BEZEICHNUNG WERT ADDITION) + (while (not (= (cdr (assoc 0 (entget e))) "SEQEND")) + (setq typ (cdr (assoc 0 (entget e)))) + (if + (equal typ "ATTRIB") + (progn + (setq ATTRIBUT-BEZEICHNUNG (cdr (assoc 2 (entget e)))) + (setq ATTRIBUT-WERT (cdr (assoc 1 (entget e)))) + (if (= ADDITION 0) ; Attributwert GANZ ersetzen + (progn + (if (equal ATTRIBUT-BEZEICHNUNG BEZEICHNUNG) + (entmod (subst (cons 1 WERT) + (assoc 1 (entget e)) (entget e))) + ) + ) + ) + (if (= ADDITION 1) ; Attributwert ERGAENZEN + (progn + (if (equal ATTRIBUT-BEZEICHNUNG BEZEICHNUNG) + (entmod (subst (cons 1 (strcat ATTRIBUT-WERT WERT)) + (assoc 1 (entget e)) (entget e))) + ) + ) + ) + + ) ; Ende ----progn + ) + (setq e (entnext e)) + ) +) +;-------------------------------------------------------------------------- +(setq lw "m:") +(setvar "attreq" 0) +(setq + v-lay (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10") + v-col (list "7" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10") + v-ltyp (list "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" "continuous" ) +) +;---------------------------------------------------------------------------- +(prompt "\nSSG-Menu.. (c) 2006 by SCHNENBERGER Systeme GmbH - All rights reserved") +(prompt " ") +(princ) diff --git a/doc/acadsst/Spinnerei/alt/pu1pu2.lsp b/doc/acadsst/Spinnerei/alt/pu1pu2.lsp new file mode 100644 index 0000000..5dc26fb --- /dev/null +++ b/doc/acadsst/Spinnerei/alt/pu1pu2.lsp @@ -0,0 +1,697 @@ +; PU1PU2 - Putzstation ; +; -----------------------------------------------------------------------; +; AW 1.3.98 ; +;------------------------------------------------------------------------; + +(defun start() + (setq auswahl-satz nil) + (setvar "limcheck" 0) + (command "_vports" "_S" "aktiv" "_Y") + (setq BMOD (getvar "BLIPMODE") + MOSM (getvar "OSMODE") + MSNA (getvar "SNAPMODE") + MORT (getvar "ORTHOMODE") + CLAY (getvar "CLAYER") ; aktuelle Ebene + MECH (getvar "MENUECHO") + BKSYM (getvar "UCSICON") + UCSF (getvar "UCSFOLLOW") + Z-HOEHE (getvar "THICKNESS") + ERHEB (getvar "ELEVATION") + ) + (princ) +) + +(defun Dbox (/ Dat) + (setq Dat (load_dialog (strcat lw "/acadsst/spinne/pu1pu2.DCL"))) + (if (not (new_dialog "pu1pu2" Dat)) + (exit) + ) +; (set_tile "SPULEN" m_SPULEN) ; Spulen pro Spulenzug - default: "36" +; (set_tile "TEILUNG" m_TEILUNG)) ; Spulenzugteilung - default: "150" + (set_tile "RICHTUNG" m_RICHTUNG) ; Drehrichtung - default: "LINKS" + (set_tile "FUSS" m_FUSS) ; FUSS - default: OPPOSITE + VERBUNDEN + (set_tile "ANTRIEB" m_ANTRIEB) ; Reibradantrieb - default: "mit Antrieb" (PU2) + (set_tile "GERUEST" m_GERUEST) ; mit Gerst + (set_tile "BEMASS" m_BEMASS) ; keine Bemassung + (SetDia) + (ACTION_TILE "FUSS" "(zeig_dia)") + (ACTION_TILE "RICHTUNG" "(zeig_dia)") + (ACTION_TILE "ANTRIEB" "(zeig_dia)") + (action_tile "accept" "(SetPara) (done_dialog)") + (action_tile "cancel" "(exit) (done_dialog)") + (start_dialog) + (unload_dialog Dat) +) + +(defun SetDia() + (setq breite (dimx_tile "anzeige")) + (setq hoehe (dimy_tile "anzeige")) + (start_image "anzeige") + (FILL_IMAGE 0 0 breite hoehe -18) + (if (and (= m_RICHTUNG "UHR")(= m_ANTRIEB "1")) ; Drehung in uhrzeigersinn+Antrieb + (progn + (if (= m_FUSS "ZURUECK") (slide_image 0 0 breite hoehe "spinne(pu2ll)")) + (if (= m_FUSS "ENTGEGEN")(slide_image 0 0 breite hoehe "spinne(pu2lr)")) + (if (= m_FUSS "ENTGVERB")(slide_image 0 0 breite hoehe "spinne(pu2lrd)")) + (if (= m_FUSS "NICHTS") (slide_image 0 0 breite hoehe "spinne(pu2lo)")) + ) + ) + (if (and (= m_RICHTUNG "GEGENUHR")(= m_ANTRIEB "1")) ; Drehung in gegenuhrzeigersinn+Antrieb + (progn + (if (= m_FUSS "ZURUECK") (slide_image 0 0 breite hoehe "spinne(pu2rr)")) + (if (= m_FUSS "ENTGEGEN")(slide_image 0 0 breite hoehe "spinne(pu2rl)")) + (if (= m_FUSS "ENTGVERB")(slide_image 0 0 breite hoehe "spinne(pu2rld)")) + (if (= m_FUSS "NICHTS") (slide_image 0 0 breite hoehe "spinne(pu2ro)")) + ) + ) + (if (and (= m_RICHTUNG "UHR") (= m_ANTRIEB "0")) ; Drehung in uhrzeigersinn und KEIN Antrieb + (progn + (if (= m_FUSS "ZURUECK") (slide_image 0 0 breite hoehe "spinne(pu1ll)")) + (if (= m_FUSS "ENTGEGEN")(slide_image 0 0 breite hoehe "spinne(pu1lr)")) + (if (= m_FUSS "ENTGVERB")(slide_image 0 0 breite hoehe "spinne(pu1lrd)")) + (if (= m_FUSS "NICHTS") (slide_image 0 0 breite hoehe "spinne(pu1lo)")) + ) + ) + (if (and (= m_RICHTUNG "GEGENUHR")(= m_ANTRIEB "0")) ; Drehung in gegenuhrzeigersinn und KEIN Antrieb + (progn + (if (= m_FUSS "ZURUECK") (slide_image 0 0 breite hoehe "spinne(pu1rr)")) + (if (= m_FUSS "ENTGEGEN")(slide_image 0 0 breite hoehe "spinne(pu1rl)")) + (if (= m_FUSS "ENTGVERB")(slide_image 0 0 breite hoehe "spinne(pu1rld)")) + (if (= m_FUSS "NICHTS") (slide_image 0 0 breite hoehe "spinne(pu1ro)")) + ) + ) + (end_image) +) + +(defun zeig_dia() + (setq m_SPULEN (get_tile "SPULEN")) + (setq m_TEILUNG (get_tile "TEILUNG")) + (setq m_RICHTUNG (get_tile "RICHTUNG")) ; Drehrichtung + (setq m_FUSS (get_tile "FUSS")) ; Weichenkonfiguration am Ein- und Ausfahrt + (setq m_ANTRIEB (get_tile "ANTRIEB")) ; Reibradantrieb + (setq m_GERUEST (get_tile "GERUEST")) ; Gerst + (setq m_BEMASS (get_tile "BEMASS")) ; Bemassung + (SetDia) +) + +(defun SetPara () + (setq m_SPULEN (get_tile "SPULEN")) + (setq m_TEILUNG (get_tile "TEILUNG")) + (setq m_RICHTUNG (get_tile "RICHTUNG")) + (setq m_FUSS (get_tile "FUSS")) + (setq m_ANTRIEB (get_tile "ANTRIEB")) + (setq m_GERUEST (get_tile "GERUEST")) + (setq m_BEMASS (get_tile "BEMASS")) + ;------------------------------------------------------- + (initget (+ 2 4)) + ;------------------------------------------------------- +) + + +(defun datain () + ;------------------------------------------------------- + ;>>>> Eingabeteil <<<<<<< + ;------------------------------------------------------- + (if (= m_TEILUNG "0") ; 150-er Teilung + (progn + (setq A '(7250 9050 10850 12650 14450 16250 18050 19850)) + (setq B '(4900 6100 7300 8500 9700 10900 12100 13300)) + ) + ) + (if (= m_TEILUNG "1") ; 165-er Teilung + (progn + (setq A '(7790 9770 11750 13730 15710 17690 19670 21650)) + (setq B '(5260 6580 7900 9220 10540 11860 13180 14500)) + ) + ) + + (setq ANZ_SPULEN (atoi m_SPULEN)) ; um Wert NULL zu vermeiden + + (setq ALTFANG (getvar "osmode")) + (initget (+ 1 2 4)) + (command "_layer" "_m" "A-2" "_c" "2" "" "") + (command "_ortho" "_off") + (setq P0 (getpoint "\nPick insertion point : ")) +; (setq P0 (list (car P0) (cadr P0) UK-SCHIENE)) + (bl-name P0) ;--> Block-Name definieren -> Rckgabe: block-kennung + (setq P1 (list (car p0) (+ (cadr p0) 2650) UK-SCHIENE)) + (if (= m_RICHTUNG "GEGENUHR") ; gegenuhrzeigersinn + (progn + (setq P2 (list (+ (nth ANZ_SPULEN A)(car p1)) (- (cadr P1) 200) UK-SCHIENE)) + (setq P3 (list (car p2) (cadr p0) UK-SCHIENE)) + (setq P4 (list (+ (car p1) 800) (cadr p1) UK-SCHIENE)) + (setq P6 (list (car p4) (- (cadr p4) 200) UK-SCHIENE)) + (setq P8 (list (car p4) (- (cadr p4) 2650) UK-SCHIENE)) + (setq P10 (list (car p0) (+ (cadr p0) 800) UK-SCHIENE)) + (setq P11 (list (car p0) (- (cadr p1) 1050) UK-SCHIENE)) + (setq P15 (list (+ (car p0) 300) (+ (cadr p0) 300) 0)) + ) + (progn + (setq P2 (list (+ (nth ANZ_SPULEN A)(car p1)) (cadr P1) UK-SCHIENE)) + (setq P3 (list (car p2) (+ (cadr p0) 200) UK-SCHIENE)) + (setq P4 (list (+ (car p0) 800) (cadr p0) UK-SCHIENE)) + (setq P6 (list (car p4) (+ (cadr p4) 200) UK-SCHIENE)) + (setq P8 (list (car p4) (+ (cadr p4) 2650) UK-SCHIENE)) + (setq P10 (list (car p0) (+ (cadr p0) 1050) UK-SCHIENE)) + (setq P11 (list (car p1) (- (cadr p1) 500) UK-SCHIENE)) + (setq P15 (list (+ (car p0) 300) (+ (cadr p0) 500) 0)) + ) + ) + + (setq P14 (list (+ (nth ANZ_SPULEN B)(car p0)) (cadr P0) UK-SCHIENE)) + (command "_ortho" "_on") + (setvar "osmode" 0) + (command "_elevation" "0") + (command "_ucs" "_w") + (command "_fill" "_off") + (setq M_ARTINR "821106002") ; artikel.nr fuer alu-profil APG110 +) + +(defun geometrie() + ; ---- Bereich einstellen + (command "_vpoint" "0,0,1") + (command "_zoom" "_w" (list (- (car P0) 2000) (- (cadr P0) 2000) 0) + (list (+ (car P2) 2000) (+ (cadr P2) 2000) 0)) + ; --- Putzstation einfgen + (command "_layer" "_m" "Putzstation" "_c" "5" "" "") + (command "_insert" (strcat lw "/acadsst/spinne/putzstation") P15 "" "" "") + (setq auswahl-satz (ssget "_L")) + + (if (= m_RICHTUNG "GEGENUHR") ; in gegenuhrzeigerrichtung + (progn + (command "_layer" "_m" "A-2" "_c" "2" "" "") + (command "_insert" (strcat lw "/acadsst/alu/b1109065") + (list (car P0) (cadr P0) (+ (caddr P0) UK-SCHIENE)) "" "" "180") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat lw "/acadsst/alu/wbe2r20") P1 "" "" "") + (ssadd (entlast) auswahl-satz) + (if (= m_FUSS "ENTGEGEN") + (progn + (command "_insert" (strcat lw "/acadsst/alu/wbe2r20") P2 "" "" "180") + (ssadd (entlast) auswahl-satz) + ) + ) + (if (or (= m_FUSS "ZURUECK") (= m_FUSS "ENTGVERB")) + (progn + (command "_insert" (strcat lw "/acadsst/alu/wb2r20") P2 "" "" "180") + (ssadd (entlast) auswahl-satz) + ) + ) + + (gemeinsame-el) + + ; Fu bearbeiten + (if (= m_FUSS "ZURUECK") + (progn + (command "_layer" "_m" "A-2" "_c" "2" "" "") + (command "_insert" (strcat lw "/acadsst/alu/b1109065") P3 "" "" "") + (command "_mirror" (entlast) "" P8 P3 "_Y") + (ssadd (entlast) auswahl-satz) + (setq P12 (list (car p2) (+ (cadr p2) 650) UK-SCHIENE)) + (ap-zeichnen (list (car p3) (+ (cadr p3) 800) UK-SCHIENE) P12) + (command "_layer" "_m" "A-10" "_c" "8" "" "") + (command "_insert" (strcat lw "/acadsst/alu/tv80") (list (car p3) (+ (cadr p3) 800) UK-SCHIENE) "" "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat lw "/acadsst/alu/alu_ks") P12 "" "" "") + (ssadd (entlast) auswahl-satz) + ) + ) + (if (= m_FUSS "ENTGEGEN") + (progn + (command "_layer" "_m" "A-2" "_c" "2" "" "") + (command "_insert" (strcat lw "/acadsst/alu/b1109065") P3 "" "" "") + (ssadd (entlast) auswahl-satz) + ) + ) + (if (= m_FUSS "ENTGVERB") + (progn + (command "_layer" "_m" "A-2" "_c" "2" "" "") + (command "_insert" (strcat lw "/acadsst/alu/sw90l70") P3 "" "" "") + (ssadd (entlast) auswahl-satz) + (setq P12 (list (car p2) (+ (cadr p2) 650) UK-SCHIENE)) + (setq P13 (list (car p3) (- (cadr p3) 440) UK-SCHIENE)) + (ap-zeichnen P13 P12) + (command "_layer" "_m" "A-10" "_c" "8" "" "") + (command "_insert" (strcat lw "/acadsst/alu/alu_ks") P12 "" "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat lw "/acadsst/alu/alu_ks") P13 "" "" "") + (ssadd (entlast) auswahl-satz) + ) + ) + + ; zieren + (command "_layer" "_m" "A-1" "_c" "1" "" "") + (command "_insert" (strcat lw "/acadsst/zier2d/pf0_l") + (list (+ (car p0) 2000) (cadr p0) UK-SCHIENE) "0.5" "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat lw "/acadsst/zier2d/pf0_l") + (list (+ (car p1) 2000) (cadr p1) UK-SCHIENE) "0.5" "" "180") + (ssadd (entlast) auswahl-satz) + (if (or (= m_FUSS "ZURUECK") (= m_FUSS "ENTGVERB")) + (progn + (command "_insert" (strcat lw "/acadsst/zier2d/pf0_l") + (list (car p3) (+ (cadr p3) 1300) UK-SCHIENE) "0.5" "" "90") + (ssadd (entlast) auswahl-satz) + ) + ) + + (prompt (strcat "Modul-Lnge=" (itoa (+ LAENGE 1650 (* WIEDERHOLE 6000))))) + (prompt "\n") + ) + ) ; ENDE (if (= m_RICHTUNG "GEGENUHR") + + (if (= m_RICHTUNG "UHR") ; in uhrzeigerrichtung + (progn + (command "_layer" "_m" "A-2" "_c" "2" "" "") + (command "_insert" (strcat lw "/acadsst/alu/wbe2l20") P0 "" "" "180") + (setq auswahl-satz (ssget "_L")) + (command "_insert" (strcat lw "/acadsst/alu/b1109065") P1 "" "" "90") + (ssadd (entlast) auswahl-satz) + (if (= m_FUSS "ZURUECK") + (progn + (command "_insert" (strcat lw "/acadsst/alu/b1109065") P2 "" "" "") + (ssadd (entlast) auswahl-satz) + ) + ) + (if (= m_FUSS "ENTGEGEN") + (progn + (command "_insert" (strcat lw "/acadsst/alu/b1109065") P2 "" "" "180") + (command "_mirror" (entlast) "" P3 P2 "_Y") + (ssadd (entlast) auswahl-satz) + ) + ) + (if (= m_FUSS "ENTGVERB") + (progn + (command "_insert" (strcat lw "/acadsst/alu/sw90r70") P2 "" "" "180") + (ssadd (entlast) auswahl-satz) + ) + ) + + (gemeinsame-el) + + ; Fu bearbeiten + (if (= m_FUSS "ZURUECK") + (progn + (command "_layer" "_m" "A-2" "_c" "2" "" "") + (command "_insert" (strcat lw "/acadsst/alu/wb2l20") P3 "" "" "") + (ssadd (entlast) auswahl-satz) + (setq P12 (list (car p2) (- (cadr p2) 800) UK-SCHIENE)) + (ap-zeichnen (list (car p3) (- (cadr p3) 650) UK-SCHIENE) P12) + (command "_layer" "_m" "A-10" "_c" "8" "" "") + (command "_insert" (strcat lw "/acadsst/alu/alu_ks") (list (car p3) (- (cadr p3) 650) UK-SCHIENE) "" "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat lw "/acadsst/alu/tv80") P12 "" "" "") + (ssadd (entlast) auswahl-satz) + ) + ) + (if (= m_FUSS "ENTGEGEN") + (progn + (command "_layer" "_m" "A-2" "_c" "2" "" "") + (command "_insert" (strcat lw "/acadsst/alu/wbe2l20") P3 "" "" "") + (ssadd (entlast) auswahl-satz) + ) + ) + (if (= m_FUSS "ENTGVERB") + (progn + (command "_layer" "_m" "A-2" "_c" "2" "" "") + (command "_insert" (strcat lw "/acadsst/alu/wb2l20") P3 "" "" "") + (ssadd (entlast) auswahl-satz) + (setq P12 (list (car p2) (+ (cadr p2) 360) UK-SCHIENE)) + (setq P13 (list (car p3) (- (cadr p3) 650) UK-SCHIENE)) + (ap-zeichnen P13 P12) + (command "_layer" "_m" "A-10" "_c" "8" "" "") + (command "_insert" (strcat lw "/acadsst/alu/alu_ks") P12 "" "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat lw "/acadsst/alu/alu_ks") P13 "" "" "") + (ssadd (entlast) auswahl-satz) + ) + ) + + ; zieren + (command "_layer" "_m" "A-1" "_c" "1" "" "") + (command "_insert" (strcat lw "/acadsst/zier2d/pf0_l") (list (+ (car p1) 1500) (cadr p1) UK-SCHIENE) "0.5" "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat lw "/acadsst/zier2d/pf0_l") (list (+ (car p0) 1500) (cadr p0) UK-SCHIENE) "0.5" "" "180") + (ssadd (entlast) auswahl-satz) + (if (or (= m_FUSS "ZURUECK") (= m_FUSS "ENTGVERB")) + (progn + (command "_insert" (strcat lw "/acadsst/zier2d/pf0_l") (list (car p3) (+ (cadr p3) 1300) UK-SCHIENE) "0.5" "" "90") + (ssadd (entlast) auswahl-satz) + ) + ) + + (prompt (strcat "Modul-Lnge=" (itoa (+ LAENGE 1650 (* WIEDERHOLE 6000))))) + (prompt "\n") + ) + ) ; ENDE (if (= m_RICHTUNG "UHR") +) + + +(defun gemeinsame-el() + ; trapezverbindungselemente + (command "_layer" "_m" "A-10" "_c" "8" "" "") + (command "_insert" (strcat lw "/acadsst/alu/tv80") P4 "" "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat lw "/acadsst/alu/tv80") P6 "" "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat lw "/acadsst/alu/tv80") P8 "" "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat lw "/acadsst/alu/tv80") P10 "" "" "") + (ssadd (entlast) auswahl-satz) + (command "_insert" (strcat lw "/acadsst/alu/tv80") P11 "" "" "") + (ssadd (entlast) auswahl-satz) + + ; -- ap trger zeichnen - ABSTAND ermitteln + (ap-zeichnen P10 P11) + (setq LAENGE (fix (- (nth ANZ_SPULEN A) 1650))) + (setq WIEDERHOLE (fix (/ LAENGE 6000))); wenn > 6000 ist der faktor > 0 + (if (> WIEDERHOLE 0) + (progn + (repeat WIEDERHOLE + (setq P5 (list (+ (car p4) 6000) (cadr p4) UK-SCHIENE)) + (ap-zeichnen P4 P5) + (setq P4 P5) ; punkte vertauschen + (setq P7 (list (+ (car p6) 6000) (cadr p6) UK-SCHIENE)) + (ap-zeichnen P6 P7) + (setq P6 P7) ; punkte vertauschen + (setq P9 (list (+ (car p8) 6000) (cadr p8) UK-SCHIENE)) + (ap-zeichnen P8 P9) + (setq P8 P9) ; punkte vertauschen + (setq LAENGE (- LAENGE 6000)) + ) + ) + ) + +; (if (= m_RICHTUNG "GEGENUHR") + (if (= m_FUSS "ENTGEGEN") + (progn + (setq P5 (list (+ (car p4) LAENGE 50) (cadr p4) UK-SCHIENE)) + (setq P7 (list (+ (car p6) LAENGE 50) (cadr p6) UK-SCHIENE)) + ) + (progn + (setq P5 (list (+ (car p4) LAENGE) (cadr p4) UK-SCHIENE)) + (setq P7 (list (+ (car p6) LAENGE) (cadr p6) UK-SCHIENE)) + ) + ) +; ) + (ap-zeichnen P4 P5) + (ap-zeichnen P6 P7) + (if (= m_FUSS "ENTGVERB") + (setq P9 (list (+ (car p8) LAENGE 150) (cadr p8) UK-SCHIENE)) + (setq P9 (list (+ (car p8) LAENGE 50) (cadr p8) UK-SCHIENE)) + ) + (ap-zeichnen P8 P9) +) + +(defun ap-zeichnen (anfang ende) + (command "_layer" "_m" "A-2" "_c" "2" "" "") + (bl-name anfang) ;--> Block-Name definieren -> Rckgabe: element-name + (command "_line" anfang ende "") + (setq auswahl-ap (ssget "_L")) + (mach-block anfang "0" AUSWAHL-AP) + (attribute-aendern "0" "2" "3" (itoa (fix (distance anfang ende))) "" block-kennung + M_ARTINR (strcat "APG110 L= " (itoa (fix (distance anfang ende)))) "" "") + (ssadd (entlast) auswahl-satz) + (setq auswahl-ap nil) + (command "_layer" "_m" "A-10" "_c" "8" "" "") + (command "_insert" (strcat lw "/acadsst/alu/tv80") ende "" "" "") + (ssadd (entlast) auswahl-satz) +) + +(defun BEMASSUNG () + ;--------- + ; Bemaung + ;--------- + (command "_layer" "_m" "A-8" "_c" "8" "" "") + (command "_dimtad" "0") + (command "_dimtxt" "125") + (command "_dimasz" "40") +; (setvar "osmode" 0) + (command "_dimaligned" P0 P1 (list (- (car p0) 400) (cadr p0) 0)) + (ssadd (entlast) auswahl-satz) + (command "_dimlinear" P11 P2 (list (- (car p11) 400) (cadr p11) 0)) + (ssadd (entlast) auswahl-satz) + (if (= m_BEMASS "1") + (progn + (command "_layer" "_m" "F-8" "_c" "8" "" "") + (command "_dimlinear" P0 P14 (list (+ (car p0) 2000) (- (cadr p0) 400) 0 )) + (ssadd (entlast) auswahl-satz) + ) + ) +) + +(defun motor() + (if (= m_RICHTUNG "GEGENUHR") + (progn + (command "_layer" "_m" "F-1" "_c" "1" "" "") + (command "_insert" (strcat lw "/acadsst/foerder/ra1") P14 "" "" "") + (command "_insert" (strcat lw "/acadsst/foerder/ra2_200") (list (car P14) (+ (cadr P14) 2450) UK-SCHIENE) "" "" "") + ) + ) + (if (= m_RICHTUNG "UHR") + (progn + (command "_layer" "_m" "F-1" "_c" "1" "" "") + (command "_insert" (strcat lw "/acadsst/foerder/ra2_200") P14 "" "" "") + (command "_insert" (strcat lw "/acadsst/foerder/ra1") (list (car P14) (+ (cadr P14) 2650) UK-SCHIENE) "" "" "") + ) + ) +) + +; ---- GERUEST zeichnen ---------------------------------------------------- +(defun structure () + (setq T1 (list (- (car p0) 600) (- (cadr p0) 1175) UK-GERUEST)) + (setq T2 (list (+ (car p0) 1400) (- (cadr p0) 1175) UK-GERUEST)) + (setq T3 (list (- (car p3) 1400) (- (cadr p0) 1175) UK-GERUEST)) + (setq T4 (list (+ (car p3) 600) (- (cadr p0) 1175) UK-GERUEST)) + (setq T5 (list (car t1) (- (cadr p0) 325) UK-GERUEST)) + (setq T6 (list (+ (car P0) 100) (- (cadr p0) 325) UK-GERUEST)) + + ; ---- eine 3-Flche als Unterlage zeichnen + (command "_layer" "_m" "Boden" "_c" "8" "" "") + (command "_3dface" (list (car T1) (cadr T1) 0) (list (car T4) (cadr T4) 0) + (list (car T4) (+ (cadr T4) 5000) 0) (list (car T1) (+ (cadr T4) 5000) 0) "") + (ssadd (entlast) auswahl-satz) + + ; ---- RT80/80 zeichnen --------------------------------------------------- + (setq auswahl-rt nil) + (command "_layer" "_m" "D-5" "_c" "5" "" "") + ; -- das kurze Stck zwischen DRT80 + (bl-name T6) ;--> Block-Name definieren -> Rckgabe: element-name + (command "_line" (list (car T6) (+ (cadr T6) 35) (caddr T6)) (list (car T6) (+ (cadr T6) 3265) (caddr T6)) "") + (setq auswahl-rt (ssget "_L")) + (mach-block T1 "0" AUSWAHL-rt) + (attribute-aendern "0" "2" "5" "3230" "115-115" block-kennung + "825144004" "RT 80/80 L= 3230" "" "") + (ssadd (entlast) auswahl-satz) + (if (not (= m_FUSS "NICHTS")) + (progn + (command "_copy" (entlast) "" T6 (list (+ (car T6) (- (fix (distance T1 T4)) 1400)) (cadr T6) (caddr T6))) + (ssadd (entlast) auswahl-satz) + ) + ) + (setq auswahl-rt nil) + (bl-name T1) ;--> Block-Name definieren -> Rckgabe: element-name + (command "_line" T1 (list (car T1) (+ (cadr T1) 5000) (caddr T1)) "") + (setq auswahl-rt (ssget "_L")) + (mach-block T1 "0" AUSWAHL-rt) + (attribute-aendern "0" "2" "5" "5000" "250-250" block-kennung + "825144005" "RT 80/80 L= 5000" "" "") + (ssadd (entlast) auswahl-satz) + (setq auswahl-rt nil) + + ; -------- wie oft kopieren ? ------------------------------------------- + (setq wieoft (+ (fix (/ (distance P0 P3) 3000)) 1)) + (setq copyabstand (fix (/ (distance P0 P3) wieoft))) + (setq wieoft (- wieoft 2)) + (copy_element T1 T2 T3 T4) + + ; --- DRT 80 -> 1-mal zeichnen und 4 mal kopieren + (command "_layer" "_m" "D-1" "_c" "1" "" "") + (bl-name T5) ;--> Block-Name definieren -> Rckgabe: element-name + (command "_line" (list (+ (car T5) 35) (cadr T5) (caddr T5)) + (list (+ (car T5) 1965) (cadr T5) (caddr T5)) "") + (setq auswahl-rt (ssget "_L")) + (mach-block T5 "0" AUSWAHL-rt) + (attribute-aendern "0" "2" "5" "1930" "250-180" block-kennung + "825084002" "DRT 80 L= 1930" "" "") + (ssadd (entlast) auswahl-satz) + (setq auswahl-rt nil) + (command "_copy" (entlast) "" T5 (list (car T5) (+ (cadr T5) 3300) (caddr T5))) + (ssadd (entlast) auswahl-satz) + (if (not (= m_FUSS "NICHTS")) + (progn + (command "_copy" (entlast) "" (list (car T5) (+ (cadr T5) 3300) (caddr T5)) + (list (+ (car T5) (fix (distance T1 T3))) (+ (cadr T5) 3300) (caddr T5))) + (ssadd (entlast) auswahl-satz) + (command "_copy" (entlast) "" (list (+ (car T5) (fix (distance T1 T3))) (+ (cadr T5) 3300) (caddr T5)) + (list (+ (car T5) (fix (distance T1 T3))) (cadr T5) (caddr T5))) + (ssadd (entlast) auswahl-satz) + ) + ) + + ; 2" Sulen --------------------------------------------------------- + (setq AUSWAHL-STR nil) + (setq TS1 (list (car T1) (- (cadr T1) 35) 0)) + (setq TS2 (list (car T2) (- (cadr T2) 35) 0)) + (setq TS3 (list (car T3) (- (cadr T3) 35) 0)) + (setq TS4 (list (car T4) (- (cadr T4) 35) 0)) + (command "_layer" "_m" "D-1" "_c" "1" "" "") + (bl-name T1) ;--> Block-Name definieren -> Rueckgabe: element-name + (setq PT1 (list (- (car TS1) 100) (- (cadr TS1) 150) 0)) + (setq PT2 (list (+ (car TS1) 100) (- (cadr TS1) 150) 0)) + (setq PT3 (list (+ (car TS1) 100) (+ (cadr TS1) 150) 0)) + (setq PT4 (list (- (car TS1) 100) (+ (cadr TS1) 150) 0)) + (setvar "thickness" 10) + (setvar "elevation" 0) + (command "_solid" PT1 PT2 PT4 PT3 "") + (setq AUSWAHL-STR (ssget "_L")) + (setvar "thickness" 2990) + (setvar "elevation" 10) + (command "_circle" TS1 "30") + (ssadd (entlast) AUSWAHL-STR) + (setvar "thickness" 0) + (setvar "elevation" 0) + (mach-block TS1 "0" AUSWAHL-STR) + (attribute-aendern "0" "0" "25" "3000" "" block-kennung "821004025" "SL 2\" mit Fussplatte" "" "") + (ssadd (entlast) auswahl-satz) + (setq AUSWAHL-STR nil) + (copy_element TS1 TS2 TS3 TS4) + + ; ----- UPAT Duebel 4 Stck ---------------------------------------- + (command "_layer" "_m" "D-10" "_c" "10" "" "") + (setq WINKEL 0) + (setvar "thickness" 0) + (setvar "elevation" 0) + (command "_insert" (strcat lw "/acadsst/rohr/d_einzel") TS1 "" "" (rtos WINKEL)) + (attribute-aendern "0" "0" "25" "" "" block-kennung "922021003" "HST M12/20" "4" "") + (ssadd (entlast) AUSWAHL-SATZ) + (copy_element TS1 TS2 TS3 TS4) + (setq WINKEL (+ WINKEL 5)) + (command "_insert" (strcat lw "/acadsst/rohr/d_einzel") TS1 "" "" (rtos WINKEL)) + (attribute-aendern "0" "0" "25" "" "" block-kennung "923014001" "UPAT PSL-ANKER TYP B 14/10" "4" "") + (ssadd (entlast) AUSWAHL-SATZ) + (copy_element TS1 TS2 TS3 TS4) + + ; ---- KLEMMRING EINFACH + (command "_layer" "_m" "D-4" "_c" "4" "" "") + (command "_insert" (strcat lw "/acadsst/rohr/" "D_1KR") (list (car TS1) (cadr TS1) 2620) "" "" "") + (ssadd (entlast) AUSWAHL-SATZ) + (copy_element TS1 TS2 TS3 TS4) + (command "_insert" (strcat lw "/acadsst/rohr/" "D_1KR") (list (car TS1) (cadr TS1) 2500) "" "" "") + (ssadd (entlast) AUSWAHL-SATZ) + (copy_element TS1 TS2 TS3 TS4) + + ; Sulen und Klemmringe spiegeln auf die andere Seite + (command "_mirror" "_w" (list (- (car T1) 500) (- (cadr T1) 500) 0) + (list (+ (car T4) 500) (+ (cadr T4) 500) 4000) "" + (list (car P0) (+ (cadr P0) 1325) 0) + (list (+ (car P0) 500) (+ (cadr P0) 1325) 0) "_N" + ) +) + + +; ---- ELEMENTE KOPIEREN ----------------------------------------------------------------- +(defun copy_element (TK1 TK2 TK3 TK4) + (command "_copy" (entlast) "" TK1 TK2) + (ssadd (entlast) auswahl-satz) + (setq AP_BEF_90 (+ AP_BEF_90 3)) ; Rohrschelle fr AP kpl. + (setq TM (list (+ (car TK1) 2000) (cadr TK1) (caddr TK1))) + (repeat wieoft + (setq TN (list (+ (car TM) copyabstand) (cadr TM) (caddr TM))) + (command "_copy" (entlast) "" TM TN) + (ssadd (entlast) auswahl-satz) + (setq AP_BEF_90 (+ AP_BEF_90 3)) ; Rohrschelle fr AP kpl. + (setq TM TN) + ) + (command "_copy" (entlast) "" TM TK3) + (ssadd (entlast) auswahl-satz) + (setq AP_BEF_90 (+ AP_BEF_90 3)) ; Rohrschelle fr AP kpl. + (if (not (= m_FUSS "NICHTS")) + (progn + (command "_copy" (entlast) "" TK3 TK4) + (ssadd (entlast) auswahl-satz) + ) + ) +) + +(defun schluss() + (IF clay + (progn + (command "_layer" "_set" clay "") + (setvar "BLIPMODE" bmod) + (setvar "CMDECHO" 1) + (setvar "MENUECHO" mech) + (setvar "OSMODE" mosm) + (setvar "SNAPMODE" msna) + (setvar "ORTHOMODE" mort) + (setvar "UCSICON" bksym) + (setvar "UCSFOLLOW" ucsf) + (setvar "THICKNESS" Z-HOEHE) + (setvar "ELEVATION" ERHEB) + ) + ) + (command "_vports" "_R" "aktiv") + (princ) +) + +;------------------------------------------------------------------------------ +(defun c:pu1pu2 ( / A B C P1 P2 P3 p4 P5 P6 P7 P8 P9 P10 P11 P12 P13 P14 P15 + T1 T2 T3 T4 T5 TS1 TS2 TS3 TS4 AUSWAHL-STR UK-SCHIENE UK-GERUEST AB_BEF_90 + AB_BEF_BOG DRT80_8080 BMOD MOSM MSNA MORT CLAY MECH BKSYM UCSF HOEHE ERHEB BREITE + Z-HOEHE) + (start) + (setq auswahl-ap nil) ; auswahlsatz fuer die Bildung der traeger + (prompt "******* SPINNING MODULES - CLEANING STATIONS P1 & P2 *******") + (prompt "") + (setq UK-SCHIENE 2390) + (setq UK-GERUEST 2500) + ; --- Zaehler fr die Ermittlung der Kleinteile + ; --- Die Kleinteile werden auf D-10 in P0 gesetzt + (setq AP_BEF_90 0) ; Rohrschelle fr AP kpl. 821114019 - Abhngig von der Lnge - pro RT80/80 3 Stck + (setq AP_BEF_BOG 5) ; Bogenschelle fr AP kpl. 821114028 - am Ende des Moduls + (setq DRT80_8080 4) ; ????????????????????? + + (if (null m_SPULEN) (setq m_SPULEN "0")) ; Spulen pro Spulenzug - default: "36" + (if (null m_TEILUNG) (setq m_TEILUNG "0")) ; Spulenzugteilung - default: "150" + (if (null m_RICHTUNG) (setq m_RICHTUNG "GEGENUHR")) ; Drehrichtung - default: "gegenuhrzeigersinn" + (if (null m_FUSS) (setq m_FUSS "ENTGVERB")) ; FUSS + (if (null m_ANTRIEB) (setq m_ANTRIEB "1")) ; Reibradantrieb - default: "mit Antrieb" (PU2) + (if (null m_GERUEST) (setq m_GERUEST "1")) ; mit Gerst + (if (null m_BEMASS) (setq m_BEMASS "0")) ; keine Bemassung + ;------------------------------------------------------------------------------------------------------- + (Dbox) + (datain) + (geometrie) + (if (= m_BEMASS "1") + (bemassung) + ) + (if (= m_ANTRIEB "1") + (motor) + ) + (if (= m_GERUEST "1") + (structure) + ) +; (mach-block P0 "0" auswahl-satz) +; (command "_rotate" "_l" "" P0 pause) + ; --- Die Kleinteile in 0,0 + (command "_layer" "_m" "D-10" "_c" "10" "" "") + (setq WINKEL 0) + (setvar "thickness" 0) + (setvar "elevation" 0) + ; ---- Rohrschelle fr AP kpl. (fr die geraden Stcke) + (command "_insert" (strcat lw "/acadsst/rohr/d_einzel") P0 "" "" (rtos WINKEL)) + (attribute-aendern "0" "0" "25" "" "" block-kennung "821114019" "Rohrschelle fr AP kpl." (rtos AP_BEF_90) "") + (setq WINKEL (+ WINKEL 5)) + ; ---- Bogenschelle fr AP kpl. (fr die Bgenabhngung) + (command "_insert" (strcat lw "/acadsst/rohr/d_einzel") P0 "" "" (rtos WINKEL)) + (attribute-aendern "0" "0" "25" "" "" block-kennung "821114028" "Bogenschelle fr AP kpl." (rtos AP_BEF_BOG) "") + (setq WINKEL (+ WINKEL 5)) + ; ---- DRT 80 an RT80/80 ???????????????? + (command "_insert" (strcat lw "/acadsst/rohr/d_einzel") P0 "" "" (rtos WINKEL)) + (attribute-aendern "0" "0" "25" "" "" block-kennung "?????????" "????????" (rtos DRT80_8080) "") + (setq WINKEL (+ WINKEL 5)) + ; ---- ENDE der Einfgug der Kleinteile + + (command "_rotate" auswahl-satz "" P0 pause) + (schluss) +) diff --git a/doc/acadsst_uebersicht.md b/doc/acadsst_uebersicht.md new file mode 100644 index 0000000..73b0787 --- /dev/null +++ b/doc/acadsst_uebersicht.md @@ -0,0 +1,70 @@ +# ACADSST – Quelldateien Übersicht + +Originale AutoLISP-Makros aus `M:\ACADSST`, kopiert nach `doc/acadsst/` zur Referenz und Archivierung. +Die allgemeingültigen Muster wurden in die Standardbibliotheken unter `Lisp/ssg_*.lsp` überführt. + +--- + +## MENU/ + +Menü- und Basisroutinen, die von allen anderen Makros genutzt werden. + +| Datei | Beschreibung | +|---|---| +| `ssg.lsp` | **Kernbibliothek** – Systemvariablen sichern/wiederherstellen (`pstart`/`pend`), Fehlerhandler (`errhan`), Ja/Nein-Dialog (`ques`), Fehlermeldung mit Ton (`emsg`). Block aus Auswahlsatz erzeugen und einfügen (`block-op`, `mach-block`, `mach-block-ohne-prop`). Eindeutigen Blocknamen aus Position + Zeitstempel generieren (`bl-name`). Attribute eines Blocks ändern – einzeln (`ATTRIBUTE-AENDERN`, `ATTRIBUTE-AENDERN_IO`) und über Entity-Handle mit Suche durch die DB (`suchen-aendern`, `obj-suchen`, `einzel-attr-aendern`). Block-Hilfsfunktionen für Symbole mit/ohne Drehung und Skalierung (`c:symplac`, `c:sympl_dr`, `c:sympldr2`, `c:sympldr1`, `c:sym_scal`). Farbe eines Auswahlsatzes interaktiv ändern (`c:alt_farb`). | +| `laymr14.lsp` | **Layer-Manager** – Interaktive Layer-Operationen über das Screen-Menü: Layer eines Objektes ermitteln (`alay`), Auswahlsatz nach Layer+Typ filtern (`alel`). Layer ein- und ausschalten, einfrieren/auftauen (`lays`). Objekte auf anderen Layer verschieben oder kopieren, alle Objekte eines Typs auf einem Layer verschieben (`laymanag` Selektoren 4–7). Layernamen für Gruppen-Umbenennung berechnen (`lann`, `laqu`). Layer-Gruppenoperationen (Ein/Ausschalten, Löschen, Auswahlsatz erzeugen) über Gruppenkennung (`lgrn`). Layer-Liste im Screen-Menü blättern (`ldis`). | +| `ssg.lsp` (alt) | Ältere Versionen des Menüsystems (`ssg_110617.lsp`, `ssg_130829.lsp`, `ssg_old.lsp`) – nur zur Referenz, nicht produktiv verwenden. | + +--- + +## ILS2100/ + +Makros für das ILS 2100-Hängefördersystem (Aluminium-Schienensystem). Alle Dateien folgen demselben Dialog-Pattern: DCL laden → Vorschaubild je Auswahl → Block einfügen → Attribute setzen → Baugruppe als Block zusammenfassen. + +| Datei | Beschreibung | +|---|---| +| `ils_ae_elem.lsp` | **AS/ES-Elemente** – Antriebsstationen (AS) links/rechts und Endstationen (ES) links/rechts, jeweils mit Bosch- oder SMC-Pneumatik-Satz. AS-Elemente werden als Baugruppe (`mach-block`) mit dem zugehörigen Pneumatik-Einzelteil zusammengefasst. Dialog mit Vorschaubild je Variante. Befehl: `c:ILS_AE_ELEM`. | +| `ils_anbau_str.lsp` | **Separatoren/Stopper** – Separator Einfach-Hub (links/rechts) und Doppel-Hub in Gefällestrecke (links/rechts-Sonder). Konfigurierbar: Pneumatik-Typ (Bosch/SMC), Abhängung (an Monster-Profil LP, an LP mit/ohne PIN), Anbau-Baugruppe für Doppel-Hub. Befehl: `c:ILS_ANBAU_STR`. | +| `ils_angebot.lsp` | **Angebot-Modul** – Vereinfachte Angebotszeichnung der ILS-Komponenten (Antrieb 800/300, Spannstation 800/300, Umlenkstation, AS/ES links/rechts, Separator, Gefällestrecke, Scanner, Be-/Entladung u.a.). Geringere Detailtiefe als die Werkstattmakros. Befehl: `c:ILS_ANGEBOT`. | +| `ils_angebot_module.lsp` | **Angebotsmodule** – Ergänzung zu `ils_angebot.lsp` für weitere vereinfachte Modultypen in der Angebotsphase. | +| `ils_sensor.lsp` | **Sensoren/Automation** – Einfügen von Sensor-Blöcken (Lichtschranken, Initiatoren) auf den Layer `ILS-AUTOMATION`. Fünf Varianten via Dialog. Befehl: `c:ILS_SENSOR`. | +| `ils_verb_str.lsp` | **Verbindungsstrukturen** – Verbindungs- und Strukturelemente (Profilverbinder, Winkelverbinder, Abhängungen) auf Layer `ILS-COMPONENTS`. Sieben Varianten via Dialog. Befehl: `c:ILS_VERB_STR`. | + +--- + +## HFS/ + +Makros für das HFS-Hängefördersystem (höhenverstellbares Fördersystem). + +| Datei | Beschreibung | +|---|---| +| `hfs_mod.lsp` | **HFS-Module** – Einfügen von HFS-Modulen (KM-Light, KM 3000, KM 5000, Hochlift, 2-Way-Modul, Hochlift-TUP, HP-Sort II) auf Layer `H-2`. Dialog mit Vorschau-Slide je Modul. Befehl: `c:HFS_MOD`. | + +--- + +## Spinnerei/alt/ + +Ältere Makros für Spinnerei-Anlagen (Putzstationen). Nur zur Referenz archiviert. + +| Datei | Beschreibung | +|---|---| +| `pu1pu2.lsp` | **Putzstationen PU1/PU2** – Komplexes Makro für Reib­rad­angetriebene Putzstationen (PU2 = mit Antrieb, PU1 = ohne). Konfigurierbar: Spulenanzahl, Teilung (150/165 mm), Drehrichtung (Uhr/Gegenuhr), Fuß-Konfiguration (zurück, entgegen, verbunden, ohne). Optional: Gerüst (2″-Säulen, RT 80/80, DRT 80), Motor (RA1/RA2), Bemaßung. Zählt automatisch Kleinteile (Rohrschellen, Bogenschellen). Befehl: `c:PU1PU2`. | + +--- + +## Gemeinsame Muster (Grundlage für `Lisp/ssg_*.lsp`) + +Alle Makros teilen diese wiederkehrenden Muster, die in die Standardbibliotheken überführt wurden: + +| Muster | Quelle | Standardbibliothek | +|---|---|---| +| Systemvariablen sichern/wiederherstellen | `ssg.lsp` `pstart`/`pend`, `pu1pu2.lsp` `start`/`schluss` | `ssg_core.lsp` → `ssg-start`/`ssg-end` | +| Fehlerhandler mit Aufräumen | `ssg.lsp` `errhan` | `ssg_core.lsp` → `ssg-errhan` | +| Ja/Nein-Abfrage | `ssg.lsp` `ques` | `ssg_core.lsp` → `ssg-ques` | +| Attribute setzen (nach INSERT) | `ssg.lsp` `ATTRIBUTE-AENDERN` | `ssg_core.lsp` → `ssg-attrib-set`, `ssg-attrib-set-many` | +| Attribut per Handle suchen | `ssg.lsp` `suchen-aendern` | `ssg_core.lsp` → `ssg-attrib-by-handle` | +| Eindeutiger Blockname (Pos + Zeit) | `ssg.lsp` `bl-name` | `ssg_core.lsp` → `ssg-make-blockname` | +| Block aus Auswahlsatz erzeugen | `ssg.lsp` `mach-block` | `ssg_core.lsp` → `ssg-make-block` | +| Layer anlegen und aktivieren | alle ILS2100-Dateien | `ssg_core.lsp` → `ssg-make-layer` | +| DCL-Dialog mit Vorschaubild | alle ILS2100-Dateien | `ssg_dialog.lsp` → `ssg-dia-show-slide`, `ssg-modul-dialog` | +| Layer-Operationen interaktiv | `laymr14.lsp` | `ssg_layer.lsp` → `c:SSG-Layer*` |