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

Omniflo-Streckenzug-Test + skriptfaehige Aluprofil-Geraden

Browse Source 
Neuer Test: 4 Geraden -> 180-Grad-Kurve (4x 45-Grad-Bogen) -> 4 Geraden
als lueckenlos verketteter Streckenzug (U-Form).

- testdata/omniflo_strecke_tests.json: 12 Elemente mit berechneter,
  verketteter Platzierung (x, y, drehung, x_ende, y_ende, Bogen-Mittelpunkt)
- test_omniflo_strecke.py: Geometrie-Validierung ohne BricsCAD (Struktur,
  Katalog-Abgleich, Verkettung, Kurvensumme 180 Grad, gemeinsamer Mittelpunkt)
- test_omniflo_strecke.lsp: C:TEST_OMNIFLO_STRECKE baut die Strecke auf
- alltests.json/README.md: Test registriert und dokumentiert

OmniModulInsert.lsp: omni:insert-block in skriptfaehigen Kern omni:make-gerade
+ omni:read-src-attribs aufgeteilt. Der Kern erzeugt eine Aluprofil-Gerade
non-interaktiv aus zwei Punkten (kein getpoint/ssg-start), sodass der Test
echte Gerade-Bloecke statt nackter Linien baut. Interaktives Verhalten von
omni:insert-block bleibt unveraendert (Vorschau-Text, Laengenpruefung).

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
Michael Stangl
2026-07-23 17:51:05 +02:00
parent 258608b77f
commit 60f2b72e39
6 changed files with 864 additions and 92 deletions
Download Patch File Download Diff File Expand all files Collapse all files
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)
)
)