Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

Aus den Lisp Daten unter M:\ACADSST\MENU eine neue Standardlibrary mit Codedoku extrahiert

Browse Source
This commit is contained in:
Michael Stangl
2026-05-08 11:19:36 +02:00
parent 9fee0e1eb4
commit a3011e7c2a
19 changed files with 5509 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/README.md
+135
View File
@@ -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.
Lisp/ssg_core.lsp
+363
View File
@@ -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 <Y>: ")) "No")
)
(progn
(initget 1 "Yes No No")
(= (getkword (strcat "\n" prompt-text " Y/N <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)
Lisp/ssg_dialog.lsp
+165
View File
@@ -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)
Lisp/ssg_layer.lsp
+315
View File
@@ -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)
Lisp/ssg_load.lsp
+30
View File
@@ -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)
doc/acadsst/HFS/hfs_mod.lsp
+104
View File
@@ -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)
)
doc/acadsst/ILS2100/ils_ae_elem.lsp
+181
View File
@@ -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 -> R�ckgabe: 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)
)
doc/acadsst/ILS2100/ils_anbau_str.lsp
+243
View File
@@ -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 (Gefälle) LINKS
)
(if (= m_DWG_NAME "3")
(slide_image 0 0 breite hoehe "ils2100(SEP_DH_B)") ; *SONDER* Separator Doppel-Hub (Gefälle) 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 -> R�ckgabe: 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")
;<<< Abhänger für Einfach-Hub Separator
(if (or (= m_DWG_NAME "0") (= m_DWG_NAME "1"))
(ABHAENGER)
)
;<<< Für Separator in Gefälle 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 ]für 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") ; Abhängung 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") ; Abhängung an Monster-Profil LP für 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") ; Abhängung 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")) ; Abhänger
(if (null m_ANBAU) (setq m_ANBAU "ANBAU_1")) ; Anbaubaugruppe für Separator Doppelhub
(Dbox)
(prompt "")
(datain)
(geometrie)
(setvar "osmode" ALTFANG)
)
doc/acadsst/ILS2100/ils_angebot.lsp
+383
View File
@@ -0,0 +1,383 @@
;------------------------------------------------------------------------;
; ILS 2100 ANGEBOT ;
;------------------------------------------------------------------------;
; AW 18.11.2007 ;
; 23.01.2009 Bereinigung und Ergänzung ;
;------------------------------------------------------------------------;
(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") ; Gefälle
(slide_image 0 0 breite hoehe "ils2100(B3000160)")
)
(if (= m_DWG_NAME "9") ; Scanner für BM
(slide_image 0 0 breite hoehe "ils2100(B3000170)")
)
(if (= m_DWG_NAME "10") ; Scanner manuell für 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") ; Gefälle
(mode_tile "RICHT" 1)
)
(if (= m_DWG_NAME "9") ; Scanner für BM
(mode_tile "RICHT" 1)
)
(if (= m_DWG_NAME "10") ; Scanner manuell für 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 Gefälle
(progn
(command "_layer" "_m" "ILS-SP-G" "_c" "4" "" "")
(setq BL_NAME "0_B3000160")
)
)
(if (= m_DWG_NAME "9") ; Scanner für 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 für 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 -> R�ckgabe: 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)
)
doc/acadsst/ILS2100/ils_angebot_module.lsp
+175
View File
@@ -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 -> R�ckgabe: 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)
)
doc/acadsst/ILS2100/ils_sensor.lsp
+94
View File
@@ -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 -> R�ckgabe: 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)
)
doc/acadsst/ILS2100/ils_verb_str.lsp
+107
View File
@@ -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 -> R�ckgabe: 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)
)
doc/acadsst/MENU/laymr14.lsp
+462
View File
@@ -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 m”glich
(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 erh”hen
)
(IF (> lpos mlen)
(GRTEXT mlen "Prev. ")
(GRTEXT mlen " ")
) ;R�ckschalten
(IF (> (- llen lpos) 0)
(GRTEXT (1+ mlen) "Next ")
(GRTEXT (1+ mlen) " ")
) ;Vorw„rtsschalten
(IF (= (CAR (SETQ antw (GRREAD))) 4)
(IF (< (CADR antw) mlen)
;wenn g�ltige 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))
;N„chst
(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 wählen\n"))
(PRINC (STRCAT "\nElement ist auf Layer " akly))
)
)
((= sele 3)
(IF (SETQ akly (alay "\nZiel-Ebene wählen\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 wählen\n"))
(COMMAND "_COPY" elem "" "@" "@" "_CHANGE" elem "" "_PROP" "_LA" akly "")
(emsg "Kein Layer gewählt! ")
)
(emsg "Kein Objekt gewählt! ")
)
)
((= sele 5)
(IF (SETQ elem (ssget))
(IF (SETQ akly (alay "\nObjekt auf dem Ziel-Ebene wählen\n"))
(COMMAND "_CHANGE" elem "" "_PROP" "_LA" akly "")
(emsg "Kein Layer gewählt")
)
(emsg "Kein Objekt gewählt")
)
)
((= sele 6)
(IF (SETQ akly (alay "\nZu änderndes Objekt wählen\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 gewählt")
)
)
)
(emsg "Kein Object gewählt")
)
)
((= sele 7)
(IF (SETQ akly (alay "\nDie zu ändernden Objekte wählen\n"))
(IF (SETQ elem (alel akly NIL))
(IF (SETQ akly (alay "Objekt auf der Ziel-Ebene wählen\n"))
(PROGN
(zoal)
(ared elem 3)
(IF (ques "Layer für diese Objekte ändern ?" NIL)
(COMMAND "_CHANGE" elem "" "_PROP" "_LA" akly "")
(ared elem 4)
)
(zovo)
)
(emsg "Kein Layer gewählt")
)
)
(emsg "Kein Objekt gewählt")
)
)
((= 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 wählen\n"))
(COMMAND "_LAYER" "_SET" clay "_FR" "*" "")
)
)
(IF (NOT runm)
(pend)
)
)
(PRINC)
(PRINC "\n Layermanager loaded")
(PRINC)
doc/acadsst/MENU/ssg.lsp
+518
View File
@@ -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 <Y>: ")) "No")
)
(PROGN
(INITGET 1 "Yes No No")
(= (GETKWORD (STRCAT "\n" dial " Y/N <Y>: ")) "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 <Y>: ")) "No")
)
(PROGN
(INITGET 1 "Yes No No")
(= (GETKWORD (STRCAT "\n" dial " Y/N <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 m�ssen.
; 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 SCHÖNENBERGER Systeme GmbH - All rights reserved")
(prompt " ")
(princ)
doc/acadsst/MENU/ssg_110617.lsp
+515
View File
@@ -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 <Y>: ")) "No")
)
(PROGN
(INITGET 1 "Yes No No")
(= (GETKWORD (STRCAT "\n" dial " Y/N <Y>: ")) "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 <Y>: ")) "No")
)
(PROGN
(INITGET 1 "Yes No No")
(= (GETKWORD (STRCAT "\n" dial " Y/N <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 m�ssen.
; 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 SCHÖNENBERGER Systeme GmbH - All rights reserved")
(prompt " ")
(princ)
doc/acadsst/MENU/ssg_130829.lsp
+518
View File
@@ -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 <Y>: ")) "No")
)
(PROGN
(INITGET 1 "Yes No No")
(= (GETKWORD (STRCAT "\n" dial " Y/N <Y>: ")) "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 <Y>: ")) "No")
)
(PROGN
(INITGET 1 "Yes No No")
(= (GETKWORD (STRCAT "\n" dial " Y/N <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 m�ssen.
; 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 SCHÖNENBERGER Systeme GmbH - All rights reserved")
(prompt " ")
(princ)
doc/acadsst/MENU/ssg_old.lsp
+434
View File
@@ -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 <Y>: ")) "No")
)
(PROGN
(INITGET 1 "Yes No No")
(= (GETKWORD (STRCAT "\n" dial " Y/N <Y>: ")) "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 <Y>: ")) "No")
)
(PROGN
(INITGET 1 "Yes No No")
(= (GETKWORD (STRCAT "\n" dial " Y/N <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 m�ssen.
; 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 SCHÖNENBERGER Systeme GmbH - All rights reserved")
(prompt " ")
(princ)
doc/acadsst/Spinnerei/alt/pu1pu2.lsp
+697
View File
@@ -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 Gerüst
(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")) ; Gerüst
(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 -> Rückgabe: 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 einfügen
(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-Länge=" (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-Länge=" (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 träger 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 -> Rückgabe: 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 ()
;---------
; Bemaßung
;---------
(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-Fläche 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 Stück zwischen DRT80
(bl-name T6) ;--> Block-Name definieren -> Rückgabe: 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 -> Rückgabe: 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 -> Rückgabe: 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" Säulen ---------------------------------------------------------
(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 Stück ----------------------------------------
(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)
; Säulen 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 für 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 für AP kpl.
(setq TM TN)
)
(command "_copy" (entlast) "" TM TK3)
(ssadd (entlast) auswahl-satz)
(setq AP_BEF_90 (+ AP_BEF_90 3)) ; Rohrschelle für 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 für die Ermittlung der Kleinteile
; --- Die Kleinteile werden auf D-10 in P0 gesetzt
(setq AP_BEF_90 0) ; Rohrschelle für AP kpl. 821114019 - Abhängig von der Länge - pro RT80/80 3 Stück
(setq AP_BEF_BOG 5) ; Bogenschelle für 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 Gerüst
(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 für AP kpl. (für die geraden Stücke)
(command "_insert" (strcat lw "/acadsst/rohr/d_einzel") P0 "" "" (rtos WINKEL))
(attribute-aendern "0" "0" "25" "" "" block-kennung "821114019" "Rohrschelle für AP kpl." (rtos AP_BEF_90) "")
(setq WINKEL (+ WINKEL 5))
; ---- Bogenschelle für AP kpl. (für die Bögenabhängung)
(command "_insert" (strcat lw "/acadsst/rohr/d_einzel") P0 "" "" (rtos WINKEL))
(attribute-aendern "0" "0" "25" "" "" block-kennung "821114028" "Bogenschelle für 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 Einfügug der Kleinteile
(command "_rotate" auswahl-satz "" P0 pause)
(schluss)
)
doc/acadsst_uebersicht.md
+70
View File
@@ -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*` |