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

Merge gemacht. Versuch eines Tests der lisp Routinen erstellt

Browse Source
This commit is contained in:
Michael Stangl
2026-05-20 16:31:51 +02:00
parent c2c31898e8
commit 4eb5fc92fc
27 changed files with 3948 additions and 4659 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/KreiselInsert.lsp
+198 -2
View File
@@ -35,7 +35,8 @@
;; Attribut-Definitionen: ((TAG DEFAULT) ...)
(setq *kreisel-attrib-defs*
'(("DREHRICHTUNG" "UZS")
'(("NAME" "")
("DREHRICHTUNG" "UZS")
("N_SEPARATOREN" "2")
("KREISELART" "STANDARD")
("N_SCANNER" "0")
@@ -233,6 +234,8 @@
(assoc "ABSTAND" attribs) attribs))
(setq attribs (subst (cons "DREHUNG" (rtos rotation 2 1))
(assoc "DREHUNG" attribs) attribs))
(setq attribs (subst (cons "HOEHE" (rtos (if (caddr basePoint) (caddr basePoint) 0.0) 2 1))
(assoc "HOEHE" attribs) attribs))
(setq is-pin (equal (cdr (assoc "KREISELART" attribs)) "PIN"))
;; AUTOMATISCHE NUMMER VERGEBEN
@@ -736,6 +739,199 @@
)
;; ============================================================
;; TEIL 5: KREISEL BEARBEITEN (DCL-Dialog)
;; ============================================================
;; Ausrichtungs-Definitionen: ((Label Rotation) ...)
;; Rotation in Grad: 0=rechts, 90=oben, 180=links, 270=unten
(setq *kreisel-ausrichtungen*
'(("Horizontal MS" 0.0)
("Horizontal SM" 180.0)
("Vertikal MS" 90.0)
("Vertikal SM" 270.0))
)
;; Rotation (Grad) -> Ausrichtungs-Index (fuer popup_list)
(defun kreisel-rotation-to-idx (rot / idx i entry diff)
(setq idx 0 i 0)
(foreach entry *kreisel-ausrichtungen*
(setq diff (abs (- (rem (+ rot 360.0) 360.0)
(rem (+ (cadr entry) 360.0) 360.0))))
(if (< diff 1.0) (setq idx i))
(setq i (1+ i))
)
idx
)
;; Ausrichtungs-Index -> Rotation (Grad)
(defun kreisel-idx-to-rotation (idx)
(cadr (nth idx *kreisel-ausrichtungen*))
)
;; -----------------------------------------------
;; KreiselEdit: Bestehenden Kreisel per Dialog bearbeiten
;;
;; Ablauf:
;; 1. Kreisel-Block auswaehlen (oder vorselektiert)
;; 2. DCL-Dialog mit aktuellen Werten oeffnen
;; 3. Bei OK: Block loeschen und mit neuen Werten neu zeichnen
;; -----------------------------------------------
(defun c:KreiselEdit ( / sel ss ent ed attribs basePoint rotation
dcl-pfad dat ergebnis
dlg-name dlg-abstand dlg-hoehe dlg-ausrichtung
dlg-drehrichtung dlg-kreiselart
newAbstand newRotation ausrichtLabels)
;; Implied Selection VOR ssg-start pruefen (ssg-start hebt Selektion auf)
(setq ss (ssget "I"))
(if (and ss (= (sslength ss) 1)
(= (cdr (assoc 0 (entget (ssname ss 0)))) "INSERT"))
(setq ent (ssname ss 0))
)
(ssg-start "Kreisel bearbeiten" '(("OSMODE") ("CECOLOR") ("ATTREQ") ("ATTDIA")))
(setvar "OSMODE" 0)
;; 1. Block auswaehlen (falls nicht vorselektiert)
(if (null ent)
(progn
(setq sel (entsel "\nKreisel-Block auswaehlen: "))
(if sel (setq ent (car sel)))
)
)
(if (null ent) (progn (ssg-end) (exit)))
(setq ed (entget ent))
(if (/= (cdr (assoc 0 ed)) "INSERT")
(progn (ssg-emsg "Kein Block ausgewaehlt!") (ssg-end) (exit))
)
;; 2. Bestehende Werte auslesen
(setq attribs (ssg-attrib-read ent))
(setq basePoint (cdr (assoc 10 ed)))
(setq rotation (* (/ 180.0 pi) (cdr (assoc 50 ed))))
;; Pruefen ob Block Kreisel-Attribute hat (mindestens ABSTAND)
(if (null (assoc "ABSTAND" attribs))
(progn
(ssg-emsg "Kein Kreisel-Block! (Attribut ABSTAND fehlt)")
(ssg-end)
(exit)
)
)
;; Fehlende Attribute mit Defaults auffuellen
(foreach def *kreisel-attrib-defs*
(if (null (assoc (car def) attribs))
(setq attribs (append attribs (list (cons (car def) (cadr def)))))
)
)
;; HOEHE immer aus Z-Koordinate des Einfuegepunkts befuellen
(setq attribs (subst (cons "HOEHE" (rtos (if (caddr basePoint) (caddr basePoint) 0.0) 2 1))
(assoc "HOEHE" attribs) attribs))
(princ (strcat "\n-> Bestehend: Abstand=" (cdr (assoc "ABSTAND" attribs))
" Drehung=" (rtos rotation 2 1)
" Art=" (cdr (assoc "KREISELART" attribs))))
;; 3. DCL-Dialog laden
(setq dcl-pfad (strcat (getenv "DXFM_DCL") "/kreisel_edit.dcl"))
(setq dat (load_dialog dcl-pfad))
(if (not (new_dialog "kreisel_edit" dat))
(progn (alert (strcat "Dialog nicht verfuegbar: " dcl-pfad)) (ssg-end) (exit))
)
;; Ausrichtungs-Labels fuer popup_list aufbauen
(setq ausrichtLabels "")
(foreach entry *kreisel-ausrichtungen*
(if (= ausrichtLabels "")
(setq ausrichtLabels (car entry))
(setq ausrichtLabels (strcat ausrichtLabels "\n" (car entry)))
)
)
;; Tiles initialisieren
(set_tile "name" (cdr (assoc "NAME" attribs)))
(set_tile "abstand" (cdr (assoc "ABSTAND" attribs)))
(set_tile "hoehe" (cdr (assoc "HOEHE" attribs)))
(start_list "ausrichtung")
(foreach entry *kreisel-ausrichtungen*
(add_list (car entry))
)
(end_list)
(set_tile "ausrichtung" (itoa (kreisel-rotation-to-idx rotation)))
(start_list "drehrichtung")
(add_list "UZS")
(add_list "GUZ")
(end_list)
(set_tile "drehrichtung" (if (equal (cdr (assoc "DREHRICHTUNG" attribs)) "GUZ") "1" "0"))
(start_list "kreiselart")
(add_list "STANDARD")
(add_list "PIN")
(end_list)
(set_tile "kreiselart" (if (equal (cdr (assoc "KREISELART" attribs)) "PIN") "1" "0"))
;; Actions
(action_tile "accept"
(strcat
"(setq dlg-name (get_tile \"name\"))"
"(setq dlg-abstand (get_tile \"abstand\"))"
"(setq dlg-hoehe (get_tile \"hoehe\"))"
"(setq dlg-ausrichtung (get_tile \"ausrichtung\"))"
"(setq dlg-drehrichtung (get_tile \"drehrichtung\"))"
"(setq dlg-kreiselart (get_tile \"kreiselart\"))"
"(done_dialog 1)"
)
)
(action_tile "cancel" "(done_dialog 0)")
(setq ergebnis (start_dialog))
(unload_dialog dat)
;; 4. Bei OK: Block loeschen und neu zeichnen
(if (= ergebnis 1)
(progn
;; Werte aufbereiten
(setq newAbstand (atof dlg-abstand))
(setq newRotation (kreisel-idx-to-rotation (atoi dlg-ausrichtung)))
;; Attribute aktualisieren
(setq attribs (subst (cons "NAME" dlg-name)
(assoc "NAME" attribs) attribs))
(setq attribs (subst (cons "HOEHE" dlg-hoehe)
(assoc "HOEHE" attribs) attribs))
(setq attribs (subst (cons "KREISELART"
(if (= dlg-kreiselart "1") "PIN" "STANDARD"))
(assoc "KREISELART" attribs) attribs))
(setq attribs (subst (cons "DREHRICHTUNG"
(if (= dlg-drehrichtung "1") "GUZ" "UZS"))
(assoc "DREHRICHTUNG" attribs) attribs))
;; Alten Block loeschen
(command "_.ERASE" ent "")
;; Neu zeichnen mit Z-Koordinate aus Hoehe-Dialogwert
(draw-module (list (car basePoint) (cadr basePoint) (atof dlg-hoehe))
newAbstand newRotation attribs)
(princ (strcat "\nKreisel aktualisiert: "
"Name=" dlg-name
" Abstand=" (rtos newAbstand 2 0)
" Hoehe=" dlg-hoehe
" Rotation=" (rtos newRotation 2 1)))
)
(princ "\nAbgebrochen.")
)
(ssg-end)
)
;; --------------------------------------------
;; KreiselParams: Aktuelle Parameter anzeigen
;; --------------------------------------------
@@ -806,5 +1002,5 @@
)
(princ "\nKreiselInsert.lsp geladen (Version 7.0 - Auto-Nummerierung + Beschriftung + Attribute + Redraw + Eckrad)")
(princ "\nBefehle: KreiselInsert, KreiselConnect, KreiselRedraw, KreiselQuick, KreiselParams, ILS_Eckrad")
(princ "\nBefehle: KreiselInsert, KreiselConnect, KreiselRedraw, KreiselEdit, KreiselQuick, KreiselParams, ILS_Eckrad")
(princ)
Lisp/tests.lsp
+89 -130
View File
@@ -26,75 +26,59 @@
)
;; ============================================================
;; EXPORTCSV - Alle INSERT-Entities sammeln und als JSON exportieren
;; EXPORT - Relevante INSERT-Entities sammeln und als JSON exportieren
;; Anschliessend Python-Skript aufrufen fuer CSV-Erzeugung
;; ============================================================
;; --- Wert sicher als String zurueckgeben ---
(defun csv:to-str (val)
(cond
((null val) "")
((= (type val) 'STR) val)
((= (type val) 'INT) (itoa val))
((= (type val) 'REAL) (rtos val 2 6))
(T (vl-princ-to-string val))
)
)
;; --- String fuer JSON escapen (Anfuehrungszeichen) ---
(defun csv:json-escape (s / pos result ch)
(setq result "")
(setq pos 1)
(repeat (strlen s)
(setq ch (substr s pos 1))
(cond
((= ch "\"") (setq result (strcat result "\\\"")))
((= ch "\\") (setq result (strcat result "\\\\")))
(T (setq result (strcat result ch)))
)
(setq pos (1+ pos))
)
result
;; --- String fuer JSON escapen (Anfuehrungszeichen/Backslash) ---
;; Nutzt vl-string-subst fuer die haeufigsten Faelle statt
;; zeichenweiser Verkettung (deutlich schneller bei langen Strings).
(defun csv:json-escape (s)
(setq s (vl-string-subst "\\\\" "\\" s))
(vl-string-subst "\\\"" "\"" s)
)
;; --- Attribute eines INSERT-Blocks als JSON-Objekt lesen ---
;; ename = Entity-Name des INSERT
;; Rueckgabe: String wie {"TAG1":"Wert1","TAG2":"Wert2"}
(defun csv:read-attribs (ename / obj typ tag wert result first-item)
(defun csv:read-attribs (ename / obj ed typ tag wert parts)
(setq obj (entnext ename))
(setq result "{")
(setq first-item T)
(while (and obj (not (equal (cdr (assoc 0 (entget obj))) "SEQEND")))
(setq typ (cdr (assoc 0 (entget obj))))
(if (equal typ "ATTRIB")
(setq parts nil)
(while obj
(setq ed (entget obj))
(setq typ (cdr (assoc 0 ed)))
(if (equal typ "SEQEND") (setq obj nil)
(progn
(setq tag (cdr (assoc 2 (entget obj))))
(setq wert (cdr (assoc 1 (entget obj))))
(if (not first-item)
(setq result (strcat result ","))
(if (equal typ "ATTRIB")
(setq parts (cons (strcat "\"" (csv:json-escape (cdr (assoc 2 ed)))
"\":\"" (csv:json-escape (cdr (assoc 1 ed))) "\"")
parts))
)
(setq result (strcat result
"\"" (csv:json-escape tag) "\":\""
(csv:json-escape wert) "\""))
(setq first-item nil)
(setq obj (entnext obj))
)
)
(setq obj (entnext obj))
)
(strcat result "}")
(if parts
(progn
(setq parts (reverse parts))
(strcat "{" (car parts)
(apply 'strcat (mapcar '(lambda (p) (strcat "," p)) (cdr parts)))
"}")
)
"{}"
)
)
;; --- Einen INSERT-Block als JSON-Objekt schreiben ---
(defun csv:block-to-json (ename / ed blk-name layer pt rotation handle attribs has-attribs)
(defun csv:block-to-json (ename / ed blk-name layer pt rotation handle attribs)
(setq ed (entget ename))
(setq blk-name (cdr (assoc 2 ed)))
(setq layer (cdr (assoc 8 ed)))
(setq pt (cdr (assoc 10 ed)))
(setq rotation (cdr (assoc 50 ed)))
(setq handle (cdr (assoc 5 ed)))
(setq has-attribs (cdr (assoc 66 ed)))
(if (null rotation) (setq rotation 0.0))
(if has-attribs
(if (cdr (assoc 66 ed))
(setq attribs (csv:read-attribs ename))
(setq attribs "{}")
)
@@ -104,35 +88,71 @@
",\"handle\":\"" (csv:json-escape handle) "\""
",\"x\":" (rtos (car pt) 2 4)
",\"y\":" (rtos (cadr pt) 2 4)
",\"z\":" (rtos (caddr pt) 2 4)
",\"z\":" (rtos (if (caddr pt) (caddr pt) 0.0) 2 4)
",\"rotation\":" (rtos (* (/ rotation pi) 180.0) 2 4)
",\"attribs\":" attribs
"}"
)
)
;; --- EXPORTSIVAS: Sivas-spezifischer CSV-Export mit Summierungszeilen ---
(defun c:EXPORTSIVAS ( / ss i ename json-str out-pfad py-skript cmd fh
ergebnis-pfad first-block count)
(princ "\n[EXPORTSIVAS] Sammle alle Bloecke der Zeichnung...")
;; --- Relevante Bloecke sammeln ---
;; Filtert INSERT-Entities auf exportierbare Bloecke:
;; KR_* = Kreisel Compound-Bloecke
;; AP110* = Omniflo Geraden
;; Omniflo Boegen/Weichen = rein numerische Blocknamen (SivasNr)
;; Vario* = VarioFoerderer-Bloecke
;; Gibt Auswahlsatz zurueck oder nil.
(defun csv:collect-export-blocks ( / ss-all ss-out i ename ed bname)
(setq ss-all (ssget "X" (list (cons 0 "INSERT"))))
(if (null ss-all) (setq ss-out nil)
(progn
(setq ss-out (ssadd))
(setq i 0)
(while (setq ename (ssname ss-all i))
(setq ed (entget ename))
(setq bname (cdr (assoc 2 ed)))
(if (or
(wcmatch bname "KR_*")
(wcmatch (strcase bname) "AP110*,AP_110*")
(wcmatch bname "Vario*,Staustrecke*,AUS_Element*,EIN_Element*")
;; Rein numerische Namen = Omniflo SivasNr (Boegen/Weichen)
(wcmatch bname "#*")
)
(ssadd ename ss-out)
)
(setq i (1+ i))
)
(if (= (sslength ss-out) 0) (setq ss-out nil))
)
)
ss-out
)
;; Alle INSERT-Entities in der Zeichnung
(setq ss (ssget "X" (list (cons 0 "INSERT"))))
;; --- Gemeinsame Export-Funktion ---
;; Sammelt relevante Bloecke, schreibt JSON, ruft Python auf.
;; label = Anzeigename (z.B. "EXPORTCSV")
;; py-name = Python-Skript-Name (z.B. "export_csv.py")
;; csv-name = Ergebnis-CSV-Name (z.B. "export.csv")
(defun csv:run-export (label py-name csv-name / ss i ename fh out-pfad
py-skript ergebnis-pfad cmd first-block count)
(princ (strcat "\n[" label "] Sammle relevante Bloecke..."))
(setq ss (csv:collect-export-blocks))
(if (null ss)
(progn
(princ "\n[EXPORTSIVAS] Keine Bloecke in der Zeichnung gefunden.")
(princ (strcat "\n[" label "] Keine relevanten Bloecke gefunden."))
(princ)
)
(progn
(setq count (sslength ss))
(princ (strcat "\n[EXPORTSIVAS] " (itoa count) " Bloecke gefunden."))
(princ (strcat "\n[" label "] " (itoa count) " Bloecke gefunden."))
;; JSON-Datei zusammenbauen
(setq out-pfad (strcat (getenv "DXFM_RESULTS") "/export_raw.json"))
(setq fh (open out-pfad "w"))
(if (null fh)
(progn
(princ (strcat "\n[EXPORTSIVAS] FEHLER: Kann Datei nicht oeffnen: " out-pfad))
(princ (strcat "\n[" label "] FEHLER: Kann Datei nicht oeffnen: " out-pfad))
(princ)
)
(progn
@@ -143,32 +163,28 @@
(if (not first-block)
(write-line "," fh)
)
(setq json-str (csv:block-to-json ename))
(write-line json-str fh)
(write-line (csv:block-to-json ename) fh)
(setq first-block nil)
(setq i (1+ i))
)
(write-line "]" fh)
(close fh)
(princ (strcat "\n[EXPORTSIVAS] JSON geschrieben: " out-pfad))
(princ (strcat "\n[" label "] JSON geschrieben: " out-pfad))
;; Python-Skript aufrufen
(setq py-skript (strcat (getenv "DXFM_LIB") "/export_sivas.py"))
(setq py-skript (strcat (getenv "DXFM_LIB") "/" py-name))
(if (findfile py-skript)
(progn
(setq ergebnis-pfad (strcat (getenv "DXFM_RESULTS") "/export_sivas.csv"))
(setq ergebnis-pfad (strcat (getenv "DXFM_RESULTS") "/" csv-name))
(setq cmd (strcat "python \"" py-skript "\""
" \"" out-pfad "\""
" \"" (getenv "DXFM_DATA") "\""
" \"" ergebnis-pfad "\""))
(princ (strcat "\n[EXPORTSIVAS] Rufe Python auf..."))
(command "_.SHELL" cmd)
(if (findfile ergebnis-pfad)
(princ (strcat "\n[EXPORTSIVAS] CSV erstellt: " ergebnis-pfad))
(princ "\n[EXPORTSIVAS] WARNUNG: CSV-Datei wurde nicht erzeugt.")
)
(princ (strcat "\n[" label "] Rufe Python auf..."))
(startapp "cmd" (strcat "/c " cmd))
(princ (strcat "\n[" label "] Export gestartet: " ergebnis-pfad))
)
(princ (strcat "\n[EXPORTSIVAS] FEHLER: Python-Skript nicht gefunden: " py-skript))
(princ (strcat "\n[" label "] FEHLER: Python-Skript nicht gefunden: " py-skript))
)
)
)
@@ -177,69 +193,12 @@
(princ)
)
;; --- EXPORTSIVAS: Sivas-spezifischer CSV-Export mit Summierungszeilen ---
(defun c:EXPORTSIVAS ()
(csv:run-export "EXPORTSIVAS" "export_sivas.py" "export_sivas.csv")
)
;; --- EXPORTCSV: Einfache Item-Liste aller Bloecke (ohne Summierung) ---
;; Nutzt dieselben csv:* Hilfsfunktionen und export_raw.json,
;; ruft export_csv.py auf fuer die einfache CSV-Erzeugung.
(defun c:EXPORTCSV ( / ss i ename json-str out-pfad py-skript cmd fh
ergebnis-pfad first-block count)
(princ "\n[EXPORTCSV] Sammle alle Bloecke der Zeichnung...")
(setq ss (ssget "X" (list (cons 0 "INSERT"))))
(if (null ss)
(progn
(princ "\n[EXPORTCSV] Keine Bloecke in der Zeichnung gefunden.")
(princ)
)
(progn
(setq count (sslength ss))
(princ (strcat "\n[EXPORTCSV] " (itoa count) " Bloecke gefunden."))
(setq out-pfad (strcat (getenv "DXFM_RESULTS") "/export_raw.json"))
(setq fh (open out-pfad "w"))
(if (null fh)
(progn
(princ (strcat "\n[EXPORTCSV] FEHLER: Kann Datei nicht oeffnen: " out-pfad))
(princ)
)
(progn
(write-line "[" fh)
(setq i 0)
(setq first-block T)
(while (setq ename (ssname ss i))
(if (not first-block)
(write-line "," fh)
)
(setq json-str (csv:block-to-json ename))
(write-line json-str fh)
(setq first-block nil)
(setq i (1+ i))
)
(write-line "]" fh)
(close fh)
(princ (strcat "\n[EXPORTCSV] JSON geschrieben: " out-pfad))
;; Python-Skript aufrufen
(setq py-skript (strcat (getenv "DXFM_LIB") "/export_csv.py"))
(if (findfile py-skript)
(progn
(setq ergebnis-pfad (strcat (getenv "DXFM_RESULTS") "/export.csv"))
(setq cmd (strcat "python \"" py-skript "\""
" \"" out-pfad "\""
" \"" (getenv "DXFM_DATA") "\""
" \"" ergebnis-pfad "\""))
(princ (strcat "\n[EXPORTCSV] Rufe Python auf..."))
(command "_.SHELL" cmd)
(if (findfile ergebnis-pfad)
(princ (strcat "\n[EXPORTCSV] CSV erstellt: " ergebnis-pfad))
(princ "\n[EXPORTCSV] WARNUNG: CSV-Datei wurde nicht erzeugt.")
)
)
(princ (strcat "\n[EXPORTCSV] FEHLER: Python-Skript nicht gefunden: " py-skript))
)
)
)
)
)
(princ)
(defun c:EXPORTCSV ()
(csv:run-export "EXPORTCSV" "export_csv.py" "export.csv")
)
bin/create_tests.bat
+41
View File
@@ -0,0 +1,41 @@
@echo off
REM ================================================================
REM create_tests.bat - ILS Testlauf
REM
REM Ablauf:
REM 1. Umgebung setzen
REM 2. Python: ILStest.dxf mit Linien erzeugen
REM 3. BricsCAD: Kreisel einfuegen, exportieren, speichern
REM 4. Python: Ergebnisse gegen Referenzen validieren
REM ================================================================
call "%~dp0setenv.bat"
echo.
echo ================================================================
echo ILS TEST - Schritt 1: Basis-DXF erzeugen
echo ================================================================
python "%DXFM_TESTS%\create_ILStest_dxf.py" "%DXFM_TESTS%\ILStest.dxf"
if errorlevel 1 (
echo FEHLER: DXF-Erzeugung fehlgeschlagen!
pause
exit /b 1
)
echo.
echo ================================================================
echo ILS TEST - Schritt 2: BricsCAD starten und Kreisel erzeugen
echo ================================================================
echo BricsCAD wird gestartet mit dem Testskript...
echo Nach Abschluss des Tests BricsCAD schliessen.
echo.
start /wait "" %BRISCAD% /s "%DXFM_TESTS%\ILS_test.scr"
echo.
echo ================================================================
echo ILS TEST - Schritt 3: Ergebnisse validieren
echo ================================================================
python "%DXFM_TESTS%\validate_tests.py" "%DXFM_RESULTS%" "%DXFM_TESTS%\references"
echo.
pause
bin/setenv.bat
+1
View File
@@ -15,6 +15,7 @@ REM Pfade fuer verschiedene Komponenten
set "DXFM_BIN=%DXFMAKRO%\bin"
set "DXFM_LIB=%DXFMAKRO%\lib"
set "DXFM_DATA=%DXFMAKRO%\data"
set "DXFM_TESTS=%DXFMAKRO%\tests"
set "DXFM_CFG=%DXFMAKRO%\cfg"
set "DXFM_LOG=%DXFMAKRO%\log"
set "DXFM_BLOCKS=%DXFMAKRO%\Blocks"
doc/acadsst/HFS/hfs_mod.lsp
-104
View File
@@ -1,104 +0,0 @@
;------------------------------------------------------------------------;
; 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
@@ -1,181 +0,0 @@
;------------------------------------------------------------------------;
; 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
@@ -1,243 +0,0 @@
;------------------------------------------------------------------------;
; 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
@@ -1,383 +0,0 @@
;------------------------------------------------------------------------;
; 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
@@ -1,175 +0,0 @@
;------------------------------------------------------------------------;
; 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
@@ -1,94 +0,0 @@
;------------------------------------------------------------------------;
; 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
@@ -1,107 +0,0 @@
;------------------------------------------------------------------------;
; 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
@@ -1,462 +0,0 @@
;............................................................
;: 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
@@ -1,518 +0,0 @@
(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
@@ -1,515 +0,0 @@
(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
@@ -1,518 +0,0 @@
(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
@@ -1,434 +0,0 @@
(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
@@ -1,697 +0,0 @@
; 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
@@ -1,70 +0,0 @@
# 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*` |
lib/export_csv.py
+22 -11
View File
@@ -84,15 +84,27 @@ def build_gerade_merkmale(block):
def build_kreisel_merkmale(block):
attribs = block.get("attribs", {})
abstand_mm = attribs.get("ABSTAND", "2300")
try:
abstand_m = str(round(float(abstand_mm) / 1000.0, 2))
except (ValueError, TypeError):
abstand_m = "2.3"
hoehe_mm = attribs.get("HOEHE", "0")
try:
hoehe_m = str(round(float(hoehe_mm) / 1000.0, 2))
except (ValueError, TypeError):
hoehe_m = "0"
return {
"Abstand (Kreiselachse A - Kreiselachse) in Meter": "3",
"Anzahl der Separatoren": "2",
"Kreiselart": "Standard",
"Anzahl der Scanner": "0",
"Anzahl der Rampen": "0",
"Höhe in m": "2",
"Drehrichtung": "UZS",
"Drehung": block.get("rotation", 0.0)
"Abstand (Kreiselachse A - Kreiselachse) in Meter": abstand_m,
"Anzahl der Separatoren": attribs.get("N_SEPARATOREN", "2"),
"Kreiselart": attribs.get("KREISELART", "STANDARD"),
"Anzahl der Scanner": attribs.get("N_SCANNER", "0"),
"Anzahl der Rampen": attribs.get("N_RAMPEN", "0"),
"Höhe in m": hoehe_m,
"Drehrichtung": attribs.get("DREHRICHTUNG", "UZS"),
"Drehung": block.get("rotation", 0.0),
"Name": attribs.get("NAME", ""),
}
@@ -100,7 +112,6 @@ def build_kreisel_merkmale(block):
# Bekannte Blocknamen
# ---------------------------------------------------------------------------
KREISEL_BLOCKS = {"AN8", "SP8"}
SKIP_BLOCKS = {"K1", "K2", "K3", "K4", "KS_EIN", "KS_AUS"}
@@ -182,8 +193,8 @@ def process_blocks(blocks, lookup):
})
continue
# ILS Kreisel
if bname in KREISEL_BLOCKS:
# ILS Kreisel (Compound-Bloecke mit Praefix KR_)
if bname.startswith("KR_"):
elem_nr += 1
kreisel_count += 1
items.append({
lib/export_sivas.py
+36 -15
View File
@@ -104,21 +104,33 @@ def build_gerade_merkmale(block):
def build_kreisel_merkmale(block):
"""Merkmale-JSON fuer einen ILS Kreisel."""
"""Merkmale-JSON fuer einen ILS Kreisel (liest Attribute aus Block)."""
attribs = block.get("attribs", {})
abstand_mm = attribs.get("ABSTAND", "2300")
try:
abstand_m = str(round(float(abstand_mm) / 1000.0, 2))
except (ValueError, TypeError):
abstand_m = "2.3"
hoehe_mm = attribs.get("HOEHE", "0")
try:
hoehe_m = str(round(float(hoehe_mm) / 1000.0, 2))
except (ValueError, TypeError):
hoehe_m = "0"
return {
"Abstand (Kreiselachse A - Kreiselachse) in Meter": "3",
"Anzahl der Separatoren": "2",
"Kreiselart": "Standard",
"Anzahl der Scanner": "0",
"Anzahl der Rampen": "0",
"Höhe in m": "2",
"Drehrichtung": "UZS",
"Drehung": block.get("rotation", 0.0)
"Abstand (Kreiselachse A - Kreiselachse) in Meter": abstand_m,
"Anzahl der Separatoren": attribs.get("N_SEPARATOREN", "2"),
"Kreiselart": attribs.get("KREISELART", "STANDARD"),
"Anzahl der Scanner": attribs.get("N_SCANNER", "0"),
"Anzahl der Rampen": attribs.get("N_RAMPEN", "0"),
"Höhe in m": hoehe_m,
"Drehrichtung": attribs.get("DREHRICHTUNG", "UZS"),
"Drehung": block.get("rotation", 0.0),
"Name": attribs.get("NAME", ""),
}
# --- Bekannte Blocknamen fuer nicht-Omniflo Elemente ---
KREISEL_BLOCKS = {"AN8", "SP8"}
## Kreisel-Bloecke werden ueber Praefix "KR_" erkannt (siehe process_blocks)
VARIO_BLOCKS = {
"AUS_Element_links", "EIN_Element_links",
@@ -243,8 +255,8 @@ def process_blocks(blocks, lookup):
counters["gesamtlaenge_ap110"] += 2000.0
continue
# ILS Kreisel
if bname in KREISEL_BLOCKS:
# ILS Kreisel (Compound-Bloecke mit Praefix KR_)
if bname.startswith("KR_"):
elem_nr += 1
kreisel_count += 1
items.append({
@@ -255,10 +267,19 @@ def process_blocks(blocks, lookup):
"anzahl": 1,
"merkmale": build_kreisel_merkmale(block)
})
attribs = block.get("attribs", {})
counters["anzahl_kreisel"] += 1
counters["sep_kreisel_ohne_pin"] += 2
counters["laengen_kreisel"] += 3.0
counters["anzahl_separatoren"] += 2
n_sep = int(attribs.get("N_SEPARATOREN", "2") or "2")
kreiselart = attribs.get("KREISELART", "STANDARD")
if kreiselart == "PIN":
counters["anzahl_kreisel_pinband"] += 1
counters["sep_kreisel_pin"] += n_sep
else:
counters["sep_kreisel_ohne_pin"] += n_sep
abstand_mm = float(attribs.get("ABSTAND", "2300") or "2300")
counters["laengen_kreisel"] += abstand_mm / 1000.0
counters["anzahl_separatoren"] += n_sep
counters["anzahl_scanner"] += int(attribs.get("N_SCANNER", "0") or "0")
if counters["anzahl_streckengruppen"] == 0:
counters["anzahl_streckengruppen"] = 1
continue
menu/SSG_LIB.mnu
+1
View File
@@ -6,6 +6,7 @@
[->Kreisel-Module]
[Einfuegen]^C^CKreiselInsert
[Verbinden]^C^CKreiselConnect
[Bearbeiten]^C^CKreiselEdit
[<-Eckrad]^C^CILS_Eckrad
[->Zusatzmodul]
[BTMT-Beladung]^C^CILS_BTMT_Beladung
tests/ILS_test.lsp
+99
View File
@@ -0,0 +1,99 @@
;; ============================================================
;; ILS_test.lsp - Automatisierter ILS Kreisel-Test
;;
;; Oeffnet ILStest.dxf, erzeugt 5 Kreisel per draw-module
;; (gleiche Kernfunktion wie KreiselConnect/KreiselInsert),
;; exportiert CSV und speichert.
;;
;; Voraussetzung: SSG_LIB muss geladen sein (ssg_load.lsp).
;; ============================================================
(defun c:ILSTEST ( / test-pfad dxf-pfad abstand z-hoehe)
(princ "\n========== ILS TEST START ==========")
(setq test-pfad (getenv "DXFM_TESTS"))
(if (null test-pfad)
(progn (princ "\nFEHLER: DXFM_TESTS nicht gesetzt!") (exit))
)
;; DXF oeffnen (erzeugt durch create_ILStest_dxf.py)
(setq dxf-pfad (strcat test-pfad "/ILStest.dxf"))
(if (not (findfile dxf-pfad))
(progn (princ (strcat "\nFEHLER: " dxf-pfad " nicht gefunden!")) (exit))
)
(command "_.OPEN" dxf-pfad)
;; Konstanten fuer die Geometrie
;; Linien: H1 bei Y=0, H2 bei Y=5000, V1 bei X=0, V2 bei X=5000
;; Alle auf Z=2500, je 2000mm lang
;; Kreiseldurchmesser=800 -> Abstand = Linienabstand - Durchmesser
(setq abstand (- 5000.0 *kreisel-durchmesser*)) ;; 4200mm
(setq z-hoehe 2500.0)
(ssg-start "ILS TEST" '(("OSMODE") ("CECOLOR") ("ATTREQ") ("ATTDIA")))
(setvar "OSMODE" 0)
(setvar "ATTREQ" 0)
(setvar "ATTDIA" 0)
;; ---- Kreisel 1: Horizontal, oben->unten (90°), STANDARD ----
;; AN-Punkt auf H2 (Y=5000), SP-Richtung nach unten (Y=0)
;; Rotation 270° = von oben nach unten
(princ "\n[TEST] Kreisel 1: Horizontal oben->unten, STANDARD")
(draw-module (list 500.0 5000.0 z-hoehe)
abstand 270.0
(list (cons "KREISELART" "STANDARD")
(cons "NAME" "TEST_H_ObenUnten")))
;; ---- Kreisel 2: Horizontal, unten->oben (270°), PIN ----
;; AN-Punkt auf H1 (Y=0), SP-Richtung nach oben (Y=5000)
;; Rotation 90° = von unten nach oben
(princ "\n[TEST] Kreisel 2: Horizontal unten->oben, PIN")
(draw-module (list 1500.0 0.0 z-hoehe)
abstand 90.0
(list (cons "KREISELART" "PIN")
(cons "NAME" "TEST_H_UntenOben")))
;; ---- Kreisel 3: Vertikal, links->rechts (0°), PIN ----
;; AN-Punkt auf V1 (X=0), SP-Richtung nach rechts (X=5000)
;; Rotation 0° = von links nach rechts
(princ "\n[TEST] Kreisel 3: Vertikal links->rechts, PIN")
(draw-module (list 0.0 500.0 z-hoehe)
abstand 0.0
(list (cons "KREISELART" "PIN")
(cons "NAME" "TEST_V_LinksRechts")))
;; ---- Kreisel 4: Vertikal, rechts->links (180°), STANDARD ----
;; AN-Punkt auf V2 (X=5000), SP-Richtung nach links (X=0)
;; Rotation 180° = von rechts nach links
(princ "\n[TEST] Kreisel 4: Vertikal rechts->links, STANDARD")
(draw-module (list 5000.0 1500.0 z-hoehe)
abstand 180.0
(list (cons "KREISELART" "STANDARD")
(cons "NAME" "TEST_V_RechtsLinks")))
;; ---- Kreisel 5: KreiselInsert-Equivalent ----
;; Position 3000/3000/2000, 6000mm lang, PIN, 10 Grad
(princ "\n[TEST] Kreisel 5: Insert 3000/3000/2000, 6000mm, PIN, 10°")
(draw-module (list 3000.0 3000.0 2000.0)
6000.0 10.0
(list (cons "KREISELART" "PIN")
(cons "NAME" "TEST_Insert")))
(ssg-end)
;; Speichern als DXF
(command "_.SAVEAS" "DXF" (strcat test-pfad "/ILStest.dxf") "_Y")
(princ "\n[TEST] DXF gespeichert.")
;; Export CSV (nutzt csv:run-export aus tests.lsp)
;; Ergebnisse landen in DXFM_RESULTS
(princ "\n[TEST] Starte CSV-Export...")
(csv:run-export "ILSTEST" "export_csv.py" "ILStest_export.csv")
(princ "\n========== ILS TEST ENDE ==========")
(princ)
)
(princ "\nILS_test.lsp geladen. Befehl: ILSTEST")
(princ)
tests/ILS_test.scr
+5
View File
@@ -0,0 +1,5 @@
(load (strcat (getenv "DXFM_LISP") "/on_start.lsp"))
_.OPEN
(strcat (getenv "DXFM_TESTS") "/ILStest.dxf")
(load (strcat (getenv "DXFM_TESTS") "/ILS_test.lsp"))
ILSTEST
tests/ILStest.dxf
+3174
View File
File diff suppressed because it is too large Load Diff
tests/create_ILStest_dxf.py
+44
View File
@@ -0,0 +1,44 @@
#!/usr/bin/env python3
# -*- coding: utf-8 -*-
"""
create_ILStest_dxf.py - Erzeugt die Basis-DXF fuer den ILS-Test.
Erstellt 4 Linien als Grundlage fuer KreiselConnect:
- 2 horizontale Linien, 5000mm Abstand, je 2000mm lang, ab (0,0,2500)
- 2 vertikale Linien, 5000mm Abstand, je 2000mm lang, ab (0,0,2500)
"""
import ezdxf
import sys
import os
def create_ils_test_dxf(output_path):
doc = ezdxf.new("R2018")
msp = doc.modelspace()
z = 2500.0
# Horizontale Linienpaare (Abstand 5000mm in Y-Richtung)
# H1: (0,0,2500) -> (2000,0,2500)
msp.add_line((0, 0, z), (2000, 0, z), dxfattribs={"layer": "S_LP", "color": 1})
# H2: (0,5000,2500) -> (2000,5000,2500)
msp.add_line((0, 5000, z), (2000, 5000, z), dxfattribs={"layer": "S_LP", "color": 1})
# Vertikale Linienpaare (Abstand 5000mm in X-Richtung)
# V1: (0,0,2500) -> (0,2000,2500)
msp.add_line((0, 0, z), (0, 2000, z), dxfattribs={"layer": "S_LP", "color": 1})
# V2: (5000,0,2500) -> (5000,2000,2500)
msp.add_line((5000, 0, z), (5000, 2000, z), dxfattribs={"layer": "S_LP", "color": 1})
doc.saveas(output_path)
print(f"[ILStest] DXF erstellt: {output_path}")
return output_path
if __name__ == "__main__":
if len(sys.argv) > 1:
out = sys.argv[1]
else:
out = os.path.join(os.getenv("DXFM_TESTS", "tests"), "ILStest.dxf")
create_ils_test_dxf(out)
tests/references/ILStest_export_ref.csv
+6
View File
@@ -0,0 +1,6 @@
Elementnummer;TeileArt;TeileId;NachbarIds;Bezeichnung;Planquadrat;rotation;Merkmale
0;"ILS 2.0 Kreisel";"REF_PLACEHOLDER";;"Kreisel :1";"X:500.00 Y:5000.00";;{"Abstand (Kreiselachse A - Kreiselachse) in Meter": "4.2", "Anzahl der Separatoren": "2", "Kreiselart": "STANDARD", "Anzahl der Scanner": "0", "Anzahl der Rampen": "0", "Höhe in m": "2.5", "Drehrichtung": "UZS", "Drehung": 270, "Name": "TEST_H_ObenUnten"}
1;"ILS 2.0 Kreisel";"REF_PLACEHOLDER";;"Kreisel :2";"X:1500.00 Y:0.00";;{"Abstand (Kreiselachse A - Kreiselachse) in Meter": "4.2", "Anzahl der Separatoren": "2", "Kreiselart": "PIN", "Anzahl der Scanner": "0", "Anzahl der Rampen": "0", "Höhe in m": "2.5", "Drehrichtung": "UZS", "Drehung": 90, "Name": "TEST_H_UntenOben"}
2;"ILS 2.0 Kreisel";"REF_PLACEHOLDER";;"Kreisel :3";"X:0.00 Y:500.00";;{"Abstand (Kreiselachse A - Kreiselachse) in Meter": "4.2", "Anzahl der Separatoren": "2", "Kreiselart": "PIN", "Anzahl der Scanner": "0", "Anzahl der Rampen": "0", "Höhe in m": "2.5", "Drehrichtung": "UZS", "Drehung": 0, "Name": "TEST_V_LinksRechts"}
3;"ILS 2.0 Kreisel";"REF_PLACEHOLDER";;"Kreisel :4";"X:5000.00 Y:1500.00";;{"Abstand (Kreiselachse A - Kreiselachse) in Meter": "4.2", "Anzahl der Separatoren": "2", "Kreiselart": "STANDARD", "Anzahl der Scanner": "0", "Anzahl der Rampen": "0", "Höhe in m": "2.5", "Drehrichtung": "UZS", "Drehung": 180, "Name": "TEST_V_RechtsLinks"}
4;"ILS 2.0 Kreisel";"REF_PLACEHOLDER";;"Kreisel :5";"X:3000.00 Y:3000.00";;{"Abstand (Kreiselachse A - Kreiselachse) in Meter": "6.0", "Anzahl der Separatoren": "2", "Kreiselart": "PIN", "Anzahl der Scanner": "0", "Anzahl der Rampen": "0", "Höhe in m": "2.0", "Drehrichtung": "UZS", "Drehung": 10, "Name": "TEST_Insert"}
Can't render this file because it contains an unexpected character in line 2 and column 76.
tests/validate_tests.py
+232
View File
@@ -0,0 +1,232 @@
#!/usr/bin/env python3
# -*- coding: utf-8 -*-
"""
validate_tests.py - Validiert ILS-Test Ergebnisse gegen Referenzdateien.
Aufruf:
python validate_tests.py <results_dir> <references_dir>
Prueft:
1. export_raw.json: Anzahl und Typ der Bloecke
2. ILStest_export.csv: Zeilenanzahl und Inhalte gegen Referenz
3. ILStest.dxf: Existenz und KR_-Block-Anzahl
"""
import json
import sys
import os
import csv
def load_json(path):
with open(path, "r", encoding="utf-8") as f:
return json.load(f)
def load_csv_lines(path):
"""Laedt CSV und gibt Liste von Dicts zurueck (ohne Header)."""
with open(path, "r", encoding="utf-8") as f:
return f.read().strip().split("\n")
def validate_raw_json(results_dir):
"""Prueft export_raw.json auf erwartete Kreisel-Bloecke."""
raw_path = os.path.join(results_dir, "export_raw.json")
if not os.path.exists(raw_path):
return False, "export_raw.json nicht gefunden"
blocks = load_json(raw_path)
kr_blocks = [b for b in blocks if b["block_name"].startswith("KR_")]
errors = []
if len(kr_blocks) != 5:
errors.append(f"Erwartet 5 KR_-Bloecke, gefunden: {len(kr_blocks)}")
# Pruefen ob alle Attribute haben
empty_attribs = [b for b in kr_blocks if not b.get("attribs")]
if empty_attribs:
errors.append(f"{len(empty_attribs)} Kreisel ohne Attribute: "
+ ", ".join(b["block_name"] for b in empty_attribs))
# Pruefen ob erwartete Namen vorhanden
expected_names = {
"TEST_H_ObenUnten", "TEST_H_UntenOben",
"TEST_V_LinksRechts", "TEST_V_RechtsLinks",
"TEST_Insert"
}
found_names = set()
for b in kr_blocks:
attribs = b.get("attribs", {})
name = attribs.get("NAME", "")
if name:
found_names.add(name)
missing = expected_names - found_names
if missing:
errors.append(f"Fehlende Kreisel-Namen: {missing}")
# Pruefen der spezifischen Werte
for b in kr_blocks:
attribs = b.get("attribs", {})
name = attribs.get("NAME", "")
if name == "TEST_Insert":
if attribs.get("ABSTAND") != "6000":
errors.append(f"TEST_Insert: ABSTAND={attribs.get('ABSTAND')}, erwartet 6000")
if attribs.get("KREISELART") != "PIN":
errors.append(f"TEST_Insert: KREISELART={attribs.get('KREISELART')}, erwartet PIN")
if abs(b.get("rotation", 0) - 10.0) > 0.1:
errors.append(f"TEST_Insert: rotation={b.get('rotation')}, erwartet 10")
if abs(b.get("z", 0) - 2000.0) > 0.1:
errors.append(f"TEST_Insert: z={b.get('z')}, erwartet 2000")
if name == "TEST_H_ObenUnten":
if attribs.get("KREISELART") != "STANDARD":
errors.append(f"TEST_H_ObenUnten: KREISELART={attribs.get('KREISELART')}, erwartet STANDARD")
if abs(b.get("rotation", 0) - 270.0) > 0.1:
errors.append(f"TEST_H_ObenUnten: rotation={b.get('rotation')}, erwartet 270")
if name == "TEST_H_UntenOben":
if attribs.get("KREISELART") != "PIN":
errors.append(f"TEST_H_UntenOben: KREISELART={attribs.get('KREISELART')}, erwartet PIN")
if name == "TEST_V_LinksRechts":
if attribs.get("KREISELART") != "PIN":
errors.append(f"TEST_V_LinksRechts: KREISELART={attribs.get('KREISELART')}, erwartet PIN")
if abs(b.get("rotation", 0) - 0.0) > 0.1:
errors.append(f"TEST_V_LinksRechts: rotation={b.get('rotation')}, erwartet 0")
if name == "TEST_V_RechtsLinks":
if attribs.get("KREISELART") != "STANDARD":
errors.append(f"TEST_V_RechtsLinks: KREISELART={attribs.get('KREISELART')}, erwartet STANDARD")
if errors:
return False, "export_raw.json Fehler:\n " + "\n ".join(errors)
return True, f"export_raw.json OK: {len(kr_blocks)} Kreisel mit Attributen"
def validate_csv(results_dir, references_dir):
"""Prueft CSV gegen Referenz (Zeilenanzahl, Kreisel-Anzahl)."""
csv_path = os.path.join(results_dir, "ILStest_export.csv")
ref_path = os.path.join(references_dir, "ILStest_export_ref.csv")
if not os.path.exists(csv_path):
return False, "ILStest_export.csv nicht gefunden"
csv_lines = load_csv_lines(csv_path)
kreisel_lines = [l for l in csv_lines[1:] if "ILS 2.0 Kreisel" in l]
errors = []
if len(kreisel_lines) != 5:
errors.append(f"Erwartet 5 Kreisel-Zeilen in CSV, gefunden: {len(kreisel_lines)}")
# Gegen Referenz vergleichen (falls vorhanden)
if os.path.exists(ref_path):
ref_lines = load_csv_lines(ref_path)
ref_kreisel = [l for l in ref_lines[1:] if "ILS 2.0 Kreisel" in l]
if len(kreisel_lines) != len(ref_kreisel):
errors.append(f"CSV hat {len(kreisel_lines)} Kreisel, Referenz hat {len(ref_kreisel)}")
# Vergleiche Merkmale (ohne TeileId, da UUID)
for i, (act, ref) in enumerate(zip(kreisel_lines, ref_kreisel)):
# Merkmale extrahieren (letztes Feld)
act_parts = act.split(";")
ref_parts = ref.split(";")
if len(act_parts) >= 8 and len(ref_parts) >= 8:
act_merkmale = act_parts[-1]
ref_merkmale = ref_parts[-1]
if act_merkmale != ref_merkmale:
errors.append(f"Zeile {i+1} Merkmale unterschiedlich:\n"
f" IST: {act_merkmale}\n"
f" SOLL: {ref_merkmale}")
else:
errors.append(f"Referenz-CSV nicht gefunden: {ref_path} (erster Lauf?)")
if errors:
return False, "CSV Fehler:\n " + "\n ".join(errors)
return True, f"CSV OK: {len(kreisel_lines)} Kreisel-Zeilen"
def validate_dxf(test_dir):
"""Prueft ob ILStest.dxf existiert und KR_-Bloecke enthaelt."""
dxf_path = os.path.join(test_dir, "ILStest.dxf")
if not os.path.exists(dxf_path):
return False, "ILStest.dxf nicht gefunden"
# Einfache Textsuche nach KR_-Blocknamen im DXF
with open(dxf_path, "r", encoding="utf-8", errors="ignore") as f:
content = f.read()
# Zaehle KR_-Blockreferenzen im ENTITIES-Bereich
entities_start = content.find("ENTITIES")
if entities_start < 0:
return False, "Kein ENTITIES-Bereich in DXF"
entities_section = content[entities_start:]
kr_count = 0
pos = 0
while True:
pos = entities_section.find("\nKR_", pos)
if pos < 0:
break
kr_count += 1
pos += 1
if kr_count < 5:
return False, f"Nur {kr_count} KR_-Referenzen in ENTITIES (erwartet mind. 5)"
return True, f"DXF OK: {kr_count} KR_-Referenzen gefunden"
def main():
if len(sys.argv) < 3:
print("Aufruf: python validate_tests.py <results_dir> <references_dir>")
print(" results_dir = Ordner mit Testergebnissen (z.B. results/)")
print(" references_dir = Ordner mit Referenzdateien (z.B. tests/references/)")
sys.exit(1)
results_dir = sys.argv[1]
references_dir = sys.argv[2]
test_dir = os.path.dirname(os.path.abspath(__file__))
print("=" * 60)
print("ILS Test Validierung")
print("=" * 60)
all_ok = True
# Test 1: export_raw.json
ok, msg = validate_raw_json(results_dir)
status = "PASS" if ok else "FAIL"
print(f"\n[{status}] {msg}")
if not ok:
all_ok = False
# Test 2: CSV Export
ok, msg = validate_csv(results_dir, references_dir)
status = "PASS" if ok else "FAIL"
print(f"\n[{status}] {msg}")
if not ok:
all_ok = False
# Test 3: DXF Datei
ok, msg = validate_dxf(test_dir)
status = "PASS" if ok else "FAIL"
print(f"\n[{status}] {msg}")
if not ok:
all_ok = False
print("\n" + "=" * 60)
if all_ok:
print("ERGEBNIS: ALLE TESTS BESTANDEN")
else:
print("ERGEBNIS: TESTS FEHLGESCHLAGEN")
print("=" * 60)
sys.exit(0 if all_ok else 1)
if __name__ == "__main__":
main()