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

Merge: Konflikt im VF/GF-Edit-Prefill aufgeloest

Browse Source 
Eingehender Branch setzt geruest-einzelmodul-Default auf "1"; lokal kamen dim- und motorseite-Vorbelegung hinzu. Aufloesung: beide lokalen Zusaetze behalten und den neuen Default "1" uebernommen (Gefaellestrecke.lsp, vf_standard.lsp).

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
Yuelin Wang
2026-07-24 08:23:04 +02:00
parent 8e5f197be0 60f2b72e39
commit 60c20519a0
21 changed files with 1715 additions and 135 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/Gefaellestrecke.lsp
+3 -3
View File
@@ -1430,7 +1430,7 @@
es-seite geruest-einzelmodul geruest-typ /
gf-bname gf-ss ent gf-insert typ-str anzahl-gf
gf-winkel-str i gf-g10z gf-korr-dz gf-osmode-alt)
(if (null geruest-einzelmodul) (setq geruest-einzelmodul "0"))
(if (null geruest-einzelmodul) (setq geruest-einzelmodul "1"))
(if (null geruest-typ) (setq geruest-typ (ssg-geruest-idx-to-typ (ssg-geruest-typ-to-idx nil))))
;; Beschriftung: Mitte der ersten Geraden, 400mm senkrecht versetzt
(gf-make-label gf-nummer hoehe-von hoehe-bis deltaH deltaL
@@ -1753,7 +1753,7 @@
(if (and prefill (equal (cdr (assoc "es-seite" prefill)) "rechts")) "1" "0"))
(set_tile "geruest_einzelmodul"
(if (and prefill (equal (cdr (assoc "geruest-einzelmodul" prefill)) "1")) "1" "0"))
(if (or (null prefill) (equal (cdr (assoc "geruest-einzelmodul" prefill)) "1")) "1" "0"))
(start_list "geruest_typ")
(foreach opt *ssg-geruest-optionen* (add_list opt))
(end_list)
@@ -2270,7 +2270,7 @@
(cons "es-winkel" es-winkel)
;; Dimension aus XDATA erkennen (Default 3D, falls Alt-Block ohne Eintrag)
(cons "dim" (cond ((ssg-dim-xdata-lesen ent)) ("3D")))
(cons "geruest-einzelmodul" (cond ((cdr (assoc "GERUEST_EINZELMODUL" attribs))) ("0")))
(cons "geruest-einzelmodul" (cond ((cdr (assoc "GERUEST_EINZELMODUL" attribs))) ("1")))
(cons "geruest-typ" (cdr (assoc "GERUEST_TYP" attribs)))))
;; AS-Seite + untere Hoehe fuer den optionalen parallelen VF-Bau
Lisp/KreiselInsert.lsp
+3 -3
View File
@@ -86,7 +86,7 @@
("ANZAHL_SEPARATOR" "2")
("ANZAHL_SCANNER" "0")
("ANZAHL_RAMPEN" "0")
("GERUEST_EINZELMODUL" "0")
("GERUEST_EINZELMODUL" "1")
("GERUEST_TYP" "Schoenenberger Geruest")
("DREHRICHTUNG" "UZS")
("DREHUNG" "0")
@@ -103,7 +103,7 @@
("DREHUNG" "0")
("NUMMER" "0")
("HOEHE" "0")
("GERUEST_EINZELMODUL" "0")
("GERUEST_EINZELMODUL" "1")
("GERUEST_TYP" "Schoenenberger Geruest")
("ID" ""))
)
@@ -1120,7 +1120,7 @@
(dbg 'hoehe)
;; 5. Geruest fuer Einzelmodul + Geruestoption abfragen
(setq geruest-einzelmodul (if (ssg-ques (ssg-text "kreisel-eckrad-geruest-frage") nil) "0" "1"))
(setq geruest-einzelmodul (if (ssg-ques (ssg-text "kreisel-eckrad-geruest-frage") T) "1" "0"))
(setq geruest-typ (ssg-ask-geruest-typ))
;; 6. Einfuegen (centerPt ist der Kreismittelpunkt)
Lisp/OmniModulInsert.lsp
+135 -92
View File
@@ -497,24 +497,142 @@
;;
;; blockname = Profiltyp (z.B. "AP60", "AP110", "APG110")
;; laengemax = Maximale Fahrstreckenlaenge in mm
;; --- Quell-Attribute einer Aluprofil-.dwg lesen (mit ID-Feld) ---
;; blockname = Profiltyp (z.B. "AP60", "AP110", "APG110")
;; Rueckgabe: Attribut-Alist (mit angehaengtem leeren "ID"-Feld) oder nil,
;; wenn *block-path* fehlt oder die Quell-.dwg keine Attribute hat.
(defun omni:read-src-attribs (blockname / srcAttribs)
(if (and (boundp '*block-path*) *block-path*)
(progn
(setq srcAttribs (ssg-attrib-read-dwg (strcat *block-path* blockname ".dwg")))
(if (and srcAttribs (not (assoc "ID" srcAttribs)))
(setq srcAttribs (append srcAttribs (list (cons "ID" ""))))
)
)
)
srcAttribs
)
;; --- Aluprofil-Gerade non-interaktiv aus zwei Punkten erzeugen ---
;;
;; Skriptfaehiger Kern von omni:insert-block: baut aus zwei bekannten
;; Punkten (Anfang pt, Ende pt2) den Compound-Block (Linie + ATTDEFs) und
;; fuegt ihn ein. Fuehrt KEINE Nutzerabfrage und KEIN ssg-start/ssg-end aus -
;; der Aufrufer sichert die Umgebung und setzt OSMODE/ATTREQ/ATTDIA=0.
;;
;; blockname = Profiltyp (z.B. "AP110")
;; pt / pt2 = Anfangs-/Endpunkt (Liste x y [z])
;; srcAttribs = Quell-Attribute (Alist) oder nil (dann Block ohne ATTDEFs)
;; textHeight / textGap = Textparameter
;; textEnt = optionaler, bereits erzeugter Vorschau-Text (Tag 1 = blockname);
;; nil -> wird hier erzeugt
;; Rueckgabe: Entity-Name des eingefuegten INSERT-Blocks oder nil.
(defun omni:make-gerade (blockname pt pt2 srcAttribs textHeight textGap textEnt /
laenge laengeStr dx dy angle angleDeg
perpX perpY textPt ed lastEnt ss e bname blockEnt
attribs attribDefs)
(setq laenge (distance (list (car pt) (cadr pt))
(list (car pt2) (cadr pt2))))
(setq laengeStr (rtos laenge 2 0))
(setq dx (- (car pt2) (car pt))
dy (- (cadr pt2) (cadr pt)))
(setq angle (atan dy dx))
(setq angleDeg (* (/ 180.0 pi) angle))
;; 1. Vorschau-Text erzeugen, falls nicht vom Aufrufer uebergeben
(if (null textEnt)
(progn
(entmake (list '(0 . "TEXT")
(cons 8 (getvar "CLAYER"))
(cons 10 (list (car pt) (cadr pt)
(if (caddr pt) (caddr pt) 0.0)))
(cons 40 textHeight)
(cons 1 blockname)
'(50 . 0.0)))
(setq textEnt (entlast))
)
)
(setq lastEnt textEnt)
;; 2. Compound-Block: Linie bei (0,0)..(laenge,0) + ATTDEFs aus Quell-Attributen
(command "_.LINE" (list 0.0 0.0) (list laenge 0.0) "")
(setq attribDefs (ssg-attrib-alist-to-defs srcAttribs))
(ssg-attrib-make-defs attribDefs 50.0)
;; Neue Entities einsammeln (alles nach textEnt)
(setq ss (ssadd))
(setq e (entnext lastEnt))
(while e (ssadd e ss) (setq e (entnext e)))
;; Block mit eindeutigem Zeitstempel-Namen erzeugen
(setq bname (strcat blockname "_" (ssg-timestamp)))
;; Falls Name schon existiert, Suffix anhaengen
(if (tblsearch "BLOCK" bname)
(setq bname (strcat bname "_" (itoa (fix (* (getvar "CDATE") 1000000)))))
)
;; Objektfang aus: sonst kann _.INSERT den Einfuegepunkt pt auf ein Objekt
;; umfangen (z.B. den Text bei pt) und die Hoehe verfaelschen.
(setvar "OSMODE" 0)
(command "_.-BLOCK" bname (list 0.0 0.0 0.0) ss "")
;; Block einfuegen (ATTREQ/ATTDIA bereits auf 0)
(command "_.INSERT" bname pt 1 1 angleDeg)
(setq blockEnt (entlast))
;; 3. Attribute setzen: Quell-Werte + LAENGE/A aktualisieren
(setq attribs srcAttribs)
(if (assoc "LAENGE" attribs)
(setq attribs (subst (cons "LAENGE" laengeStr)
(assoc "LAENGE" attribs) attribs))
(setq attribs (cons (cons "LAENGE" laengeStr) attribs))
)
(if (assoc "A" attribs)
(setq attribs (subst (cons "A" laengeStr)
(assoc "A" attribs) attribs))
(setq attribs (cons (cons "A" laengeStr) attribs))
)
(ssg-attrib-set-on blockEnt attribs)
;; 4. Text oberhalb der Linie positionieren, um Linienwinkel drehen,
;; Inhalt mit Laenge ergaenzen
(setq perpX (* (- (sin angle)) textGap)
perpY (* (cos angle) textGap))
(setq textPt (list (+ (car pt) perpX)
(+ (cadr pt) perpY)
(if (caddr pt) (caddr pt) 0.0)))
(setq ed (entget textEnt))
(setq ed (subst (cons 10 textPt) (assoc 10 ed) ed))
(if (assoc 50 ed)
(setq ed (subst (cons 50 angle) (assoc 50 ed) ed))
(setq ed (append ed (list (cons 50 angle))))
)
(setq ed (subst (cons 1 (strcat blockname " L=" laengeStr))
(assoc 1 ed) ed))
(entmod ed)
(entupd textEnt)
;; 5. Eindeutige ID zuweisen
(if (and blockEnt (atoms-family 1 '("ssg-id-generate")))
(ssg-id-generate blockEnt)
)
(princ (ssg-textf "omni-insert-block-eingefuegt" (list bname laengeStr)))
blockEnt
)
;; Aluprofil-Fahrstrecke interaktiv einfuegen (siehe Ablaufbeschreibung oben).
;; Fragt Einfuege- und Endpunkt ab und delegiert die Blockerzeugung an
;; omni:make-gerade.
(defun omni:insert-block (blockname laengemax /
pt pt2 laenge laengeStr
dx dy angle angleDeg
textEnt textHeight textGap
perpX perpY textPt ed
lastEnt ss e bname blockEnt
srcAttribs attribDefs attribs
ok)
pt pt2 laenge textEnt textHeight textGap srcAttribs ok)
(setq textHeight (ssg-cfg-or "omniflo" "text_height" 100.0))
(setq textGap (ssg-cfg-or "omniflo" "text_gap" 20.0))
;; 0. Attribute aus der Quell-.dwg lesen (vor ssg-start, da eigene INSERT/ERASE)
(setq srcAttribs (ssg-attrib-read-dwg (strcat *block-path* blockname ".dwg")))
;; ID-Attribut hinzufuegen falls noch nicht vorhanden
(if (and srcAttribs (not (assoc "ID" srcAttribs)))
(setq srcAttribs (append srcAttribs (list (cons "ID" ""))))
)
(setq srcAttribs (omni:read-src-attribs blockname))
(if (null srcAttribs)
(progn (princ (ssg-text "omni-insert-keine-attribute")) nil)
(progn
@@ -533,7 +651,7 @@
(setvar "ATTREQ" 0)
(setvar "ATTDIA" 0)
;; 1. Text horizontal am Einfuegepunkt erzeugen
;; Vorschau-Text horizontal am Einfuegepunkt (waehrend Endpunktwahl)
(entmake (list '(0 . "TEXT")
(cons 8 (getvar "CLAYER"))
(cons 10 (list (car pt) (cadr pt)
@@ -543,13 +661,13 @@
'(50 . 0.0)))
(setq textEnt (entlast))
;; 2. Endpunkt fuer Fahrstrecke abfragen (Schleife bei Ueberschreitung)
;; Endpunkt fuer Fahrstrecke abfragen (Schleife bei Ueberschreitung)
(setq ok nil)
(while (not ok)
(setq pt2 (getpoint pt (ssg-text "omni-prompt-endpunkt-fahrstrecke")))
(if (null pt2)
(progn
;; Abbruch: Text loeschen
;; Abbruch: Vorschau-Text loeschen
(command "_.ERASE" textEnt "")
(princ (ssg-text "omni-abbruch-omni"))
(setq ok T pt nil)
@@ -561,83 +679,8 @@
(alert (ssg-textf "omni-laenge-ueberschritten"
(list (rtos laenge 2 0) (rtos laengemax 2 0))))
(progn
(setq laengeStr (rtos laenge 2 0))
(setq dx (- (car pt2) (car pt))
dy (- (cadr pt2) (cadr pt)))
(setq angle (atan dy dx))
(setq angleDeg (* (/ 180.0 pi) angle))
;; 3. Compound-Block: Linie bei (0,0) + ATTDEFs aus Quell-Attributen
(setq lastEnt textEnt)
;; Linie von Ursprung bis (laenge, 0)
(command "_.LINE" (list 0.0 0.0) (list laenge 0.0) "")
;; ATTDEFs aus Quell-Attributen erzeugen
(setq attribDefs (ssg-attrib-alist-to-defs srcAttribs))
(ssg-attrib-make-defs attribDefs 50.0)
;; Neue Entities einsammeln (alles nach textEnt)
(setq ss (ssadd))
(setq e (entnext lastEnt))
(while e (ssadd e ss) (setq e (entnext e)))
;; Block mit eindeutigem Zeitstempel-Namen erzeugen
(setq bname (strcat blockname "_" (ssg-timestamp)))
;; Falls Name schon existiert, Suffix anhaengen
(if (tblsearch "BLOCK" bname)
(setq bname (strcat bname "_" (itoa (fix (* (getvar "CDATE") 1000000)))))
)
;; Objektfang aus: sonst kann _.INSERT den Einfuegepunkt pt
;; auf ein Objekt umfangen (z.B. den Text bei pt) und die
;; Hoehe verfaelschen. OSMODE via ssg-start gesichert.
(setvar "OSMODE" 0)
(command "_.-BLOCK" bname (list 0.0 0.0 0.0) ss "")
;; Block einfuegen (ATTREQ/ATTDIA bereits auf 0)
(command "_.INSERT" bname pt 1 1 angleDeg)
(setq blockEnt (entlast))
;; 4. Attribute setzen: Quell-Werte + LAENGE/A aktualisieren
(setq attribs srcAttribs)
(if (assoc "LAENGE" attribs)
(setq attribs (subst (cons "LAENGE" laengeStr)
(assoc "LAENGE" attribs) attribs))
(setq attribs (cons (cons "LAENGE" laengeStr) attribs))
)
(if (assoc "A" attribs)
(setq attribs (subst (cons "A" laengeStr)
(assoc "A" attribs) attribs))
(setq attribs (cons (cons "A" laengeStr) attribs))
)
(ssg-attrib-set-on blockEnt attribs)
;; 5. Text aktualisieren: oberhalb der Linie positionieren,
;; um Linienwinkel drehen, Inhalt mit Laenge ergaenzen
(setq perpX (* (- (sin angle)) textGap)
perpY (* (cos angle) textGap))
(setq textPt (list (+ (car pt) perpX)
(+ (cadr pt) perpY)
(if (caddr pt) (caddr pt) 0.0)))
(setq ed (entget textEnt))
(setq ed (subst (cons 10 textPt) (assoc 10 ed) ed))
(if (assoc 50 ed)
(setq ed (subst (cons 50 angle) (assoc 50 ed) ed))
(setq ed (append ed (list (cons 50 angle))))
)
(setq ed (subst (cons 1 (strcat blockname " L=" laengeStr))
(assoc 1 ed) ed))
(entmod ed)
(entupd textEnt)
;; Eindeutige ID zuweisen
(if (and blockEnt (atoms-family 1 '("ssg-id-generate")))
(ssg-id-generate blockEnt)
)
(princ (ssg-textf "omni-insert-block-eingefuegt" (list bname laengeStr)))
(omni:make-gerade blockname pt pt2 srcAttribs
textHeight textGap textEnt)
(setq ok T)
)
)
Lisp/README.md
+71
View File
@@ -358,6 +358,77 @@ Testbefehle für die Python-Integration. Export-Funktionen wurden in `export.lsp
---
## Tests
Zwei Test-Ebenen, beide gesteuert über `bin\run_tests.bat` (Details und
Verzeichnisstruktur: [`../tests/README.md`](../tests/README.md)):
1. **LISP-Unit-Tests** (`tests/test_unit.lsp`) – prüfen reine
Standardfunktionen direkt in AutoLISP, ohne Zeichnung.
2. **Zeichnungsbasierte Integrationstests** (`tests/test_*.lsp` +
`tests/test_*.py`) – erzeugen Blöcke in BricsCAD und validieren das
Ergebnis anschließend mit pytest/ezdxf.
### LISP-Unit-Tests (`test_unit.lsp`)
Testen **reine Hilfsfunktionen** – solche, die nur aus ihren Argumenten ein
Ergebnis berechnen und keine Zeichnungsdatenbank, Auswahlsätze, Dialoge oder
Blockdateien brauchen (String-, Zahl-, Vektor-, Listen- und Alist-Helfer).
Abgedeckt werden Funktionen aus `ssg_core`, `ssg_lang`, `ssg_id`, `vf_core`,
`export`, `Gefaellestrecke`, `OmniModulInsert` und `KreiselInsert`.
**Aufruf über die Kommandozeile** (startet BricsCAD headless):
```cmd
bin\run_tests.bat --lisp
```
`run_tests.bat --lisp` löscht das alte Ergebnis, startet BricsCAD mit
`tests/test_unit.scr` (lädt `ssg_load.lsp` + `test_unit.lsp`, ruft `TEST_UNIT`
auf und beendet BricsCAD), gibt danach `tests/output/unit_results.txt` aus und
liefert Exit-Code 1, wenn ein Test fehlschlägt oder kein Report entsteht.
**Aufruf direkt in BricsCAD** (SSG_LIB geladen):
```lisp
(load (strcat (getenv "DXFMAKRO") "/tests/test_unit.lsp"))
TEST_UNIT
```
**Aufbau eines Testfalls.** `test_unit.lsp` enthält ein Mini-Framework: jeder
Testfall ruft eine Funktion auf und vergleicht das Ergebnis gegen einen
erwarteten Wert. Die Assertion-Helfer zählen Treffer/Fehler mit und schreiben
je eine `PASS`/`FAIL`-Zeile:
| Helfer | Vergleich |
| --- | --- |
| `tu-eq name erwartet ist` | exakt (`equal`) – Strings, Ganzzahlen, Listen davon |
| `tu-eqf name erwartet ist` | numerisch mit Toleranz `1e-6` – Fliesskomma, auch verschachtelte Listen |
| `tu-true name ist` | Ergebnis ist nicht `nil` |
| `tu-nil name ist` | Ergebnis ist `nil` |
Beispiel – Formatierung einer ID und ein Vektor-Kreuzprodukt:
```lisp
(tu-eq "ssg-id-format/1" "0001" (ssg-id-format 1))
(tu-eqf "vec3-cross/x-cross-y" '(0.0 0.0 1.0) (vec3-cross '(1.0 0.0 0.0) '(0.0 1.0 0.0)))
```
Die Testfälle sind in `tu-tests-<modul>`-Funktionen gruppiert; `c:TEST_UNIT`
ruft alle nacheinander auf, gibt eine Zusammenfassung
(`Gesamt / PASS / FAIL`) aus und schreibt den Report `unit_results.txt` mit
einer abschließenden Zeile `RESULT: OK` bzw. `RESULT: FAIL` (die
`run_tests.bat` auswertet).
**Neuen Testfall ergänzen:** in der passenden `tu-tests-<modul>`-Funktion eine
`tu-eq`/`tu-eqf`/`tu-true`/`tu-nil`-Zeile hinzufügen. Für ein neues Modul eine
eigene `tu-tests-<modul>`-Funktion anlegen und in `c:TEST_UNIT` aufrufen.
Getestet werden sollten nur Funktionen ohne Zeichnungs-/Dialog-Umfeld – alles
mit `ssget`/`entget`/`entmake`/`command`/`vla-*`/`entsel`/DCL gehört in die
zeichnungsbasierten Integrationstests.
---
### `KreiselInsert.lsp` – ILS Kreisel und Eckrad
AutoLISP-Implementierung fuer ILS Kreisel und Eckrad. Enthaelt alle Befehle fuer Einfuegen, Verbinden, Neuzeichnen und Bearbeiten.
Lisp/export.lsp
+181 -3
View File
@@ -90,11 +90,171 @@
)
)
;; ============================================================
;; KOS-KOMPRIMIERUNG (Position + Rotation als 24-Zeichen Base64-String)
;; ============================================================
;; Kodiert Position (x,y,z in mm) und Rotation (als Quaternion qx,qy,qz,qw)
;; verlustarm (24 Bit Fixed-Point je Wert) in einen 24-Zeichen Base64-String.
;; Ported aus einer interaktiven Referenz-Routine (c:ExportKOS), hier als
;; reine Funktion fuer den automatischen Export nutzbar. Alle Elemente in
;; diesem Projekt werden ausschliesslich um die Z-Achse gedreht (siehe
;; DREHUNG-Konvention weiter unten), daher genuegt eine Halbwinkel-Quaternion
;; fuer eine reine Z-Rotation (csv:z-angle-to-quat) -- keine vollstaendige
;; Rotationsmatrix/Quaternion-Extraktion noetig.
(setq *csv-b64-chars* "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
;; --- Wert auf [min-val, max-val] begrenzen ---
(defun csv:clamp (val min-val max-val)
(max min-val (min val max-val))
)
;; --- Rotationswinkel (Grad, reine Z-Drehung) -> Quaternion (qx qy qz qw) ---
(defun csv:z-angle-to-quat (deg / rad)
(setq rad (/ (* deg pi) 180.0))
(list 0.0 0.0 (sin (/ rad 2.0)) (cos (/ rad 2.0)))
)
;; --- Liste vorzeichenbehafteter 24-Bit-Integer -> Base64 (je 4 Zeichen) ---
;; Gemeinsamer Kodierer fuer csv:kos-encode und csv:trans-encode.
(defun csv:b64-encode-ints (int-list / b64-str val)
(setq b64-str "")
(foreach val int-list
(if (< val 0) (setq val (+ val 16777216))) ; Zweierkomplement (24 Bit)
(setq b64-str (strcat b64-str
(substr *csv-b64-chars* (1+ (lsh val -18)) 1)
(substr *csv-b64-chars* (1+ (logand (lsh val -12) 63)) 1)
(substr *csv-b64-chars* (1+ (logand (lsh val -6) 63)) 1)
(substr *csv-b64-chars* (1+ (logand val 63)) 1)
))
)
b64-str
)
;; --- Position (mm) + Quaternion -> 24-Zeichen Base64-String ---
;; Fixed-Point: x,y,z (Faktor 1000 = mm) und qx,qy,qz werden je auf 24 Bit
;; gerundet (6 Werte * 4 Zeichen = 24 Zeichen). qw wird nicht mitkodiert,
;; sondern nur zur Vorzeichen-Normierung verwendet (q und -q sind dieselbe
;; Rotation). Fuer den Insertpoint (volle Lage), siehe csv:trans-encode fuer
;; reine Positionen (K1-K4).
(defun csv:kos-encode (x y z qx qy qz qw)
(if (< qw 0.0)
(setq qx (- qx) qy (- qy) qz (- qz))
)
(csv:b64-encode-ints (list
(fix (csv:clamp (* x 1000.0) -8388607 8388607))
(fix (csv:clamp (* y 1000.0) -8388607 8388607))
(fix (csv:clamp (* z 1000.0) -8388607 8388607))
(fix (csv:clamp (* qx 8388607.0) -8388607 8388607))
(fix (csv:clamp (* qy 8388607.0) -8388607 8388607))
(fix (csv:clamp (* qz 8388607.0) -8388607 8388607))
))
)
;; --- Position (nur x,y,z) -> 12-Zeichen Base64-String ---
;; Fixed-Point Faktor 10.0 (0.1 mm Genauigkeit, Bereich +-838 m), 3 Werte *
;; 4 Zeichen = 12 Zeichen. Fuer die Koordinatensysteme K1-K4 (nur Position,
;; keine Rotation). Ported aus der Referenz-Routine c:ExportTrans.
(defun csv:trans-encode (x y z)
(csv:b64-encode-ints (list
(fix (csv:clamp (* x 10.0) -8388607 8388607))
(fix (csv:clamp (* y 10.0) -8388607 8388607))
(fix (csv:clamp (* z 10.0) -8388607 8388607))
))
)
;; --- Lokalen Punkt (relativ zum Block-Ursprung) unter Beruecksichtigung der
;; Eltern-Rotation (reine Z-Drehung um den Einfuegepunkt) in Weltkoordinaten
;; umrechnen. Rueckgabe: (x y z) ---
(defun csv:local-to-world (parent-pt parent-rot-rad local-pt / c s lx ly lz pz)
(setq c (cos parent-rot-rad) s (sin parent-rot-rad))
(setq lx (car local-pt) ly (cadr local-pt))
(setq lz (if (caddr local-pt) (caddr local-pt) 0.0))
(setq pz (if (caddr parent-pt) (caddr parent-pt) 0.0))
(list
(+ (car parent-pt) (- (* lx c) (* ly s)))
(+ (cadr parent-pt) (+ (* lx s) (* ly c)))
(+ pz lz)
)
)
;; --- K1-K4-Koordinatensysteme eines Blocks als Positions-Strings lesen ---
;; ename = Entity-Name des platzierten INSERT (Omniflo Bogen/Weiche/Gerade).
;; pt/rot-rad = bereits ermittelte Welt-Position/-Rotation (radiant) des
;; Eltern-INSERT (siehe csv:block-to-json), keine erneute Abfrage.
;; Sucht in der Block-DEFINITION (wie omni:get-block-hoehe) nach direkten
;; Sub-INSERTs "K1".."K4" und rechnet deren lokale Position ueber die
;; Eltern-Rotation (reine Z-Drehung) in Weltkoordinaten um. Es wird nur die
;; POSITION kodiert (12-Zeichen-String, csv:trans-encode) - keine Rotation.
;; Zusaetzlich werden Strecken-Koordinatensysteme KS_EIN->K1 und KS_AUS->K2
;; (inkl. der KSYS_-Varianten, siehe ks-normalize-name in vf_core.lsp) gemappt,
;; sofern kein echter K1/K2 am Block vorhanden ist (echte K-Bloecke haben
;; Vorrang: sie werden vorne angehaengt, csv:k-kos liest per assoc den ersten).
;; Rueckgabe: Assoc-Liste (("K1" . "<pos-string>") ("K2" . ...) ...), nur
;; fuer tatsaechlich vorhandene K-Bloecke (nicht jedes Element hat alle 4).
(defun csv:get-k-kos-strings (ename pt rot-rad / ed bname blk-tbl sub-ent sub-ed
sub-bname sub-pt world-pt target is-real result)
(setq ed (entget ename))
(setq bname (cdr (assoc 2 ed)))
(setq blk-tbl (tblsearch "BLOCK" bname))
(setq result nil)
(if blk-tbl
(progn
(setq sub-ent (entnext (cdr (assoc -2 blk-tbl))))
(while sub-ent
(setq sub-ed (entget sub-ent))
(if (= (cdr (assoc 0 sub-ed)) "INSERT")
(progn
(setq sub-bname (strcase (cdr (assoc 2 sub-ed))))
;; Ziel-Slot bestimmen: echte K1-K4 direkt, KS_EIN/KS_AUS gemappt.
(setq is-real (wcmatch sub-bname "K1,K2,K3,K4"))
(setq target
(cond
(is-real sub-bname)
((or (= sub-bname "KS_EIN") (= sub-bname "KSYS_EIN")) "K1")
((or (= sub-bname "KS_AUS") (= sub-bname "KSYS_AUS")) "K2")
(t nil)))
;; Echte K-Bloecke immer aufnehmen (vorne = Vorrang bei assoc);
;; KS-abgeleitete nur, wenn der Slot noch nicht belegt ist.
(if (and target (or is-real (not (assoc target result))))
(progn
(setq sub-pt (cdr (assoc 10 sub-ed)))
(setq world-pt (csv:local-to-world pt rot-rad sub-pt))
(setq result (cons
(cons target
(csv:trans-encode
(car world-pt) (cadr world-pt) (caddr world-pt)))
result))
)
)
)
)
(setq sub-ent (entnext sub-ent))
)
)
)
result
)
;; --- Wert aus csv:get-k-kos-strings nach Name lesen, "" falls nicht vorhanden ---
(defun csv:k-kos (k-list name / found)
(setq found (assoc name k-list))
(if found (cdr found) "")
)
;; --- Mindesthoehe der Bounding-Box (Z-Ausdehnung), aus cfg/export.cfg ---
;; [Boundingbox] bb_minimum_height_mm, Default 1 (mm) falls nicht gesetzt.
;; Verhindert dz=0 bei flachen 2D-Bloecken (Draufsicht ohne Z-Ausdehnung).
(defun csv:bb-minimum-height-mm ()
(atof (export:cfg "Boundingbox" "bb_minimum_height_mm" "1"))
)
;; --- Bounding-Box (WCS, achsparallel) eines INSERT-Blocks ermitteln ---
;; Erzwingt vorher ein vla-update (Regen), da vla-getboundingbox sonst auf
;; nicht-regenerierten oder auf eingefrorenen Layern liegenden Bloecken scheitert.
;; Rueckgabe: Liste (cx cy cz dx dy dz) -- Mittelpunkt + Ausdehnung, oder nil bei Fehler.
(defun csv:get-bbox (ename / obj res minpt maxpt)
;; dz wird auf csv:bb-minimum-height-mm angehoben, falls kleiner (siehe dort).
(defun csv:get-bbox (ename / obj res minpt maxpt dz min-hoehe)
(setq obj (vlax-ename->vla-object ename))
(vl-catch-all-apply 'vla-update (list obj))
(setq res
@@ -107,13 +267,16 @@
(progn
(setq minpt (car res))
(setq maxpt (cadr res))
(setq dz (- (caddr maxpt) (caddr minpt)))
(setq min-hoehe (csv:bb-minimum-height-mm))
(if (< dz min-hoehe) (setq dz min-hoehe))
(list
(/ (+ (car minpt) (car maxpt)) 2.0)
(/ (+ (cadr minpt) (cadr maxpt)) 2.0)
(/ (+ (caddr minpt) (caddr maxpt)) 2.0)
(- (car maxpt) (car minpt))
(- (cadr maxpt) (cadr minpt))
(- (caddr maxpt) (caddr minpt))
dz
)
)
)
@@ -155,7 +318,12 @@
;; --- Einen INSERT-Block als JSON-Objekt schreiben ---
;; include-bbox = T -> zusaetzlich Bounding-Box (Mitte + Ausdehnung) ermitteln
;; und als "bbox"-Objekt anhaengen (nur fuer EXPORTCSV, nicht fuer EXPORTSIVAS).
(defun csv:block-to-json (ename include-bbox / ed blk-name layer pt rotation handle attribs bbox bbox-json)
;; "insertpoint" (KOS-String von Position+Rotation des Blocks selbst) und
;; "k1".."k4" (KOS-Strings der Koordinatensysteme im Block, siehe
;; csv:get-k-kos-strings) werden immer geschrieben, unabhaengig von
;; include-bbox -- Kodierung ueber csv:kos-encode (siehe dort).
(defun csv:block-to-json (ename include-bbox / ed blk-name layer pt rotation handle attribs bbox bbox-json
insert-quat insert-kos k-list)
(setq ed (entget ename))
(setq blk-name (cdr (assoc 2 ed)))
(setq layer (cdr (assoc 8 ed)))
@@ -164,6 +332,11 @@
(setq handle (cdr (assoc 5 ed)))
(if (null rotation) (setq rotation 0.0))
(setq attribs (csv:read-attribs ename))
(setq insert-quat (csv:z-angle-to-quat (* (/ rotation pi) 180.0)))
(setq insert-kos (csv:kos-encode
(car pt) (cadr pt) (if (caddr pt) (caddr pt) 0.0)
(nth 0 insert-quat) (nth 1 insert-quat) (nth 2 insert-quat) (nth 3 insert-quat)))
(setq k-list (csv:get-k-kos-strings ename pt rotation))
(setq bbox-json "")
(if include-bbox
(progn
@@ -193,6 +366,11 @@
",\"z\":" (rtos (if (caddr pt) (caddr pt) 0.0) 2 4)
",\"rotation\":" (rtos (* (/ rotation pi) 180.0) 2 4)
",\"attribs\":" attribs
",\"insertpoint\":\"" insert-kos "\""
",\"k1\":\"" (csv:k-kos k-list "K1") "\""
",\"k2\":\"" (csv:k-kos k-list "K2") "\""
",\"k3\":\"" (csv:k-kos k-list "K3") "\""
",\"k4\":\"" (csv:k-kos k-list "K4") "\""
bbox-json
"}"
)
Lisp/ssg_core.lsp
+1 -1
View File
@@ -621,7 +621,7 @@
(setq *strecke-attr-hinten*
'(("ANZAHL_SEPARATOR" "1")
("ANZAHL_SCANNER" "0")
("GERUEST_EINZELMODUL" "0")
("GERUEST_EINZELMODUL" "1")
("GERUEST_TYP" "Schoenenberger Geruest")))
;; ============================================================
Lisp/vf_core.lsp
+1 -1
View File
@@ -1076,7 +1076,7 @@
geruest-einzelmodul geruest-typ
/ vf-bname vf-ss vf-e vf-insert montagehoehe-m attdef-ypos L_GF_m-str)
(if (null hz) (setq hz 0.0))
(if (null geruest-einzelmodul) (setq geruest-einzelmodul "0"))
(if (null geruest-einzelmodul) (setq geruest-einzelmodul "1"))
(if (null geruest-typ) (setq geruest-typ (ssg-geruest-idx-to-typ (ssg-geruest-typ-to-idx nil))))
;; Beschriftungstext erzeugen
(vf-make-label vf-nummer hoehe-von hoehe-bis deltaH deltaL L_VF L_GF1 L_GF2
Lisp/vf_standard.lsp
+2 -2
View File
@@ -784,7 +784,7 @@
(set_tile "dimension"
(if (equal (cond ((cdr (assoc "dim" prefill))) ((ssg-ils-dim-aktuell))) "2D") "1" "0"))
(set_tile "geruest_einzelmodul"
(if (and prefill (equal (cdr (assoc "geruest-einzelmodul" prefill)) "1")) "1" "0"))
(if (or (null prefill) (equal (cdr (assoc "geruest-einzelmodul" prefill)) "1")) "1" "0"))
(start_list "geruest_typ")
(foreach opt *ssg-geruest-optionen* (add_list opt))
(end_list)
@@ -1192,7 +1192,7 @@
(cons "einfuegehoehe" z-start) (cons "hz" hz) (cons "seite" seite)
;; Dimension aus XDATA erkennen (Default 3D, falls Alt-Block ohne Eintrag)
(cons "dim" (cond ((ssg-dim-xdata-lesen ent)) ("3D")))
(cons "geruest-einzelmodul" (cond ((cdr (assoc "GERUEST_EINZELMODUL" attribs))) ("0")))
(cons "geruest-einzelmodul" (cond ((cdr (assoc "GERUEST_EINZELMODUL" attribs))) ("1")))
(cons "geruest-typ" (cdr (assoc "GERUEST_TYP" attribs)))
;; Motorseite aus Attribut (Default rechts, falls Alt-Block ohne Eintrag)
(cons "motorseite" (cond ((cdr (assoc "MOTORSEITE" attribs))) ("rechts")))))