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

[CHANGE] Stücklistenpositionierung in der Zeichnung mit Markierung und Tabelle

Browse Source
This commit is contained in:
Simon Hensch
2026-10-15 10:33:19 +02:00
parent 8039251bb8
commit 643164bc53
2 changed files with 348 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
dcl/stueckliste.dcl
+38
View File
@@ -0,0 +1,38 @@
// ============================================================
// stueckliste.dcl - Optionen fuer Positionen + Stueckliste
// Aufruf ueber c:SSG_FAEHNCHEN_STUECKLISTE (Lisp/ssg_stueckliste.lsp,
// ssg-sl-dialog). Vorbelegung aus cfg/stueckliste.json bzw. dem letzten Lauf.
// ============================================================
stueckliste : dialog {
label = "Positionen + Stueckliste";
: boxed_column {
label = "Layer der Positionen";
: radio_column {
key = "modus";
: radio_button { key = "m_suffix"; label = "Bauteil-Layer + Suffix"; }
: radio_button { key = "m_fest"; label = "Fester Layer"; }
}
: edit_box { key = "suffix"; label = "Suffix:"; edit_width = 20; }
: edit_box { key = "fest"; label = "Fester Layer:"; edit_width = 20; }
: text { label = "Regeln je Bauteiltyp: cfg/stueckliste.json"; }
}
: boxed_column {
label = "Stueckliste";
: edit_box { key = "tab_layer"; label = "Tabellen-Layer:"; edit_width = 20; }
: edit_box { key = "titel"; label = "Titel:"; edit_width = 30; }
}
: boxed_column {
label = "Nummerierung / Darstellung";
: edit_box { key = "startnr"; label = "Erste Positionsnummer:"; edit_width = 10; }
: edit_box { key = "faktor"; label = "Massstabsfaktor:"; edit_width = 10; }
: toggle { key = "alle_pos";
label = "Alle Positionen in der Fahne (100|101|...), jede Art.-Nr. nummeriert"; }
}
: errtile { key = "error"; }
ok_cancel;
}
tests/test_stueckliste.lsp
+310
View File
@@ -0,0 +1,310 @@
;; ============================================================
;; test_stueckliste.lsp - Szenario-Test fuer SSG_FAEHNCHEN_STUECKLISTE
;; (Lisp/ssg_stueckliste.lsp)
;;
;; Baut GR_-artige Bloecke per entmake (Saeulen mit Mehrfach-ARTINR,
;; Traeger mit Regel "mitte" auf einem anderen Layer, ein Block auf
;; gefrorenem Layer, einer ohne ARTINR, einer OHNE Attribute direkt vor
;; einem mit ARTINR) und fuehrt mehrere UNABHAENGIGE Laeufe ueber
;; ssg-sl-vorbereiten / ssg-sl-ausfuehren (ohne Dialog) aus:
;; Lauf 1 Standard (Baugruppen): erste Art.-Nr. nummeriert, Unterzeilen
;; ohne Nummer, Nummern ueber mehrere Layer, Zielpunkte, Rahmen
;; Lauf 2 alle Teile gewaehlt: schon positionierte werden uebersprungen,
;; Startnummer fortlaufend, eigene Tabelle rechts neben der ersten
;; Lauf 3 nur schon positionierte Teile: nichts zu tun
;; Lauf 4 "alle Positionen in der Fahne": "a|b|c", jede Art.-Nr. nummeriert
;; Lauf 5 Tabelle scheitert: Fahnen dieses Laufs werden zurueckgenommen
;; Lauf 6 gesperrter Ziel-Layer wird vor jeder Aenderung gemeldet
;; Je Lauf wird geprueft, dass jede Fahnennummer in SEINER Tabelle steht.
;; Artikelkatalog und Regeln kommen aus den echten Dateien
;; (data/json/geruest*.json, cfg/stueckliste.json).
;;
;; Aufruf in BricsCAD:
;; (load (strcat (getenv "DXFMAKRO") "/tests/test_stueckliste.lsp"))
;; TEST_STUECKLISTE
;;
;; Speichert tests/output/stueckliste_results.json (Konvention test_run_all).
;; ============================================================
(setq *tsl-pass* 0 *tsl-fail* 0 *tsl-fails* '())
(defun tsl-eq (name erwartet ist)
(if (equal erwartet ist 1e-6)
(progn (setq *tsl-pass* (1+ *tsl-pass*))
(princ (strcat "\n [PASS] " name)))
(progn (setq *tsl-fail* (1+ *tsl-fail*))
(setq *tsl-fails* (cons name *tsl-fails*))
(princ (strcat "\n [FAIL] " name
"\n erwartet: " (vl-princ-to-string erwartet)
"\n ist: " (vl-princ-to-string ist))))))
;; Blockdefinition mit ATTDEFs ARTINR/LAENGE/TEILEART (falls noch nicht da).
(defun tsl-blockdef (name)
(if (not (tblsearch "BLOCK" name))
(progn
(entmake (list '(0 . "BLOCK") (cons 2 name) '(70 . 2) '(10 0.0 0.0 0.0)))
(entmake '((0 . "LINE") (8 . "0") (10 0.0 0.0 0.0) (11 100.0 0.0 0.0)))
(foreach tag '("ARTINR" "LAENGE" "TEILEART")
(entmake (list '(0 . "ATTDEF") '(8 . "0") '(10 0.0 0.0 0.0)
'(40 . 10.0) '(1 . "") (cons 2 tag) (cons 3 tag)
'(70 . 0))))
(entmake '((0 . "ENDBLK")))))
name)
;; Blockdefinition OHNE Attribute (wie "pfeilrot"/"ssg-stop" in Kundenzeichnungen)
(defun tsl-blockdef-leer (name)
(if (not (tblsearch "BLOCK" name))
(progn
(entmake (list '(0 . "BLOCK") (cons 2 name) '(70 . 0) '(10 0.0 0.0 0.0)))
(entmake '((0 . "LINE") (8 . "0") (10 0.0 0.0 0.0) (11 50.0 50.0 0.0)))
(entmake '((0 . "ENDBLK")))))
name)
;; INSERT mit Attributen per entmake. Rueckgabe: ename des INSERT.
(defun tsl-insert (name layer pt rot werte / ins)
(entmake (list '(0 . "INSERT") (cons 8 layer) (cons 2 name) (cons 10 pt)
(cons 50 rot) '(66 . 1)))
(setq ins (entlast))
(foreach paar werte
(entmake (list '(0 . "ATTRIB") (cons 8 layer) (cons 10 pt) '(40 . 10.0)
(cons 1 (cdr paar)) (cons 2 (car paar)) '(70 . 0))))
(entmake '((0 . "SEQEND")))
ins)
(defun tsl-saeule-werte ()
'(("ARTINR" . "821006051,821004201,825002022,825002022")
("LAENGE" . "2500") ("TEILEART" . "Geruest Saeule 2 Zoll")))
(defun tsl-traeger-werte ()
'(("ARTINR" . "825084000") ("LAENGE" . "2305") ("TEILEART" . "Geruest Traeger")))
(defun tsl-handle (e) (cdr (assoc 5 (entget e))))
;; Fahne zu einem Block (oder nil).
(defun tsl-fahne-zu (blk / erg)
(foreach e (ssg-sl-fahnen)
(if (equal (ssg-sl-xdata-wert e *ssg-sl-app-pos* 1005) (tsl-handle blk)) (setq erg e)))
erg)
;; Erster Leader-Punkt (Zielpunkt) einer Fahne.
(defun tsl-zielpunkt (e / l)
(setq l (vlax-safearray->list
(vlax-variant-value
(vla-GetLeaderLineVertices (vlax-ename->vla-object e) 0))))
(list (nth 0 l) (nth 1 l) (nth 2 l)))
(defun tsl-text (e) (vla-get-TextString (vlax-ename->vla-object e)))
;; Tabelle eines Laufs (VLA) oder nil.
(defun tsl-tabelle (lauf / e)
(setq e (car (ssg-sl-des-laufs (ssg-sl-tabellen) *ssg-sl-app-tab* lauf)))
(if e (vlax-ename->vla-object e)))
;; Inhalt einer Tabellenzeile als Liste von 4 Strings (Pos Menge Laenge Art.-Nr.)
(defun tsl-zeile (tbo r)
(list (vla-GetText tbo r 0) (vla-GetText tbo r 1) (vla-GetText tbo r 2) (vla-GetText tbo r 3)))
;; T, wenn jede Nummer jeder Fahne des Laufs in der Tabelle des Laufs steht.
(defun tsl-lauf-konsistent-p (lauf / tbo r nummern ok)
(setq tbo (tsl-tabelle lauf) ok (if tbo T nil))
(if tbo
(progn
(setq r 2)
(repeat (- (vla-get-Rows tbo) 2)
(setq nummern (cons (vla-GetText tbo r 0) nummern) r (1+ r)))
(foreach e (ssg-sl-des-laufs (ssg-sl-fahnen) *ssg-sl-app-pos* lauf)
(foreach nr (ssg-sl-text-nummern (tsl-text e))
(if (not (member (itoa nr) nummern)) (setq ok nil))))))
ok)
;; Lauf wie der Befehl, aber ohne Dialog: Optionen aus cfg (+ Aenderungen),
;; Startnummer = naechste freie. Rueckgabe: (plan erg)
(defun tsl-lauf (enames cfg aenderungen pt / opt plan)
(setq opt (ssg-sl-optionen-start cfg (ssg-sl-letzte-nummer)))
(setq opt (ssg-sl-opt-setzen opt "titel" "TSL_TITEL"))
(foreach a aenderungen (setq opt (ssg-sl-opt-setzen opt (car a) (cdr a))))
(setq plan (ssg-sl-vorbereiten enames opt cfg))
(list plan (if (ssg-sl-opt plan "recs") (ssg-sl-ausfuehren plan opt cfg pt))))
(defun stueckliste:tests ( / saeule traeger pfeil s1 s2 s3 s4 s5 t1 t2 t3 t4 pf fz kein
elemente cfg lauf plan erg e tbo1 vorher mn mx rand opt)
(setvar "CMDECHO" 0)
(setq *ssg-sl-katalog* nil *ssg-sl-optionen* nil)
(ssg-make-layer "D-1" "7" nil)
(ssg-make-layer "D-5" "7" nil)
(ssg-make-layer "Z-1" "7" nil)
(ssg-make-layer "TSL_FROZEN" "7" nil)
(setq saeule (tsl-blockdef "GR_Saeulen_TSL1")
traeger (tsl-blockdef "GR_Traeger_TSL1")
pfeil (tsl-blockdef-leer "TSL_PFEILROT"))
;; 3 Saeulen R 2" auf D-1, Z=6000. VOR der zweiten liegt ein Block OHNE
;; Attribute - die Reihenfolge, in der "pfeilrot" frueher die ARTINR des
;; Folgeblocks erbte.
(setq s1 (tsl-insert saeule "D-1" '(0.0 0.0 6000.0) 0.0 (tsl-saeule-werte)))
(entmake (list '(0 . "INSERT") '(8 . "Z-1") (cons 2 pfeil) '(10 1500.0 0.0 0.0)))
(setq pf (entlast))
(setq s2 (tsl-insert saeule "D-1" '(3000.0 0.0 6000.0) 0.0 (tsl-saeule-werte)))
(setq s3 (tsl-insert saeule "D-1" '(6000.0 0.0 6000.0) 0.0 (tsl-saeule-werte)))
;; Traeger DRT 80, 2305 mm, auf einem ANDEREN Layer (D-5)
(setq t1 (tsl-insert traeger "D-5" '(0.0 1000.0 6000.0) 0.0 (tsl-traeger-werte)))
(setq t2 (tsl-insert traeger "D-5" '(10000.0 0.0 6000.0) (/ pi 2.0) (tsl-traeger-werte)))
;; nicht positionierbar: gefrorener Layer bzw. leeres ARTINR
(setq fz (tsl-insert traeger "TSL_FROZEN" '(0.0 5000.0 0.0) 0.0
'(("ARTINR" . "825084000") ("LAENGE" . "1000"))))
(setq kein (tsl-insert traeger "D-1" '(0.0 6000.0 0.0) 0.0
'(("ARTINR" . "") ("LAENGE" . "1000"))))
(command "_.-LAYER" "_F" "TSL_FROZEN" "")
;; --- Block ohne Attribute: nichts lesen, nichts schreiben ---
(tsl-eq "ohne attribute: ssg-ent-hat-attribute-p" nil (ssg-ent-hat-attribute-p pf))
(tsl-eq "ohne attribute: ssg-attrib-read leer" nil (ssg-attrib-read pf))
(tsl-eq "ohne attribute: csv:get-attrib leer" nil (csv:get-attrib pf "ARTINR"))
(tsl-eq "mit attributen: ssg-ent-hat-attribute-p" T (ssg-ent-hat-attribute-p s2))
(setq vorher (ssg-attrib-read s2))
(ssg-attrib-set-on pf '(("LAENGE" . "9999")))
(tsl-eq "ohne attribute: set-on aendert folgeblock nicht" vorher (ssg-attrib-read s2))
;; --- Auswahl: ohne Attribute, gefroren und ohne ARTINR fallen weg ---
(setq elemente (ssg-sl-elemente-aus-ss
(ssget "_X" (list '(0 . "INSERT") (cons 410 (getvar "CTAB"))))))
(tsl-eq "auswahl: 5 positionierbare bloecke" 5 (length elemente))
(tsl-eq "auswahl: block ohne attribute ausgelassen" nil (if (member pf elemente) T nil))
(tsl-eq "auswahl: gefroren ausgelassen" nil (if (member fz elemente) T nil))
(tsl-eq "auswahl: ohne artinr ausgelassen" nil (if (member kein elemente) T nil))
(setq cfg (ssg-sl-cfg-laden))
;; ============ Lauf 1: Standard, Saeulen + ein Traeger ============
(tsl-eq "lauf 1: noch keine nummern" nil (ssg-sl-letzte-nummer))
(setq erg (tsl-lauf (list s1 s2 s3 t1) cfg nil '(20000.0 0.0 0.0)))
(setq plan (car erg) lauf (ssg-sl-opt plan "lauf"))
(tsl-eq "lauf 1: ok" T (ssg-sl-opt (cadr erg) "ok"))
(tsl-eq "lauf 1: zeilen (unterzeilen ohne nummer)"
'((100 "821006051" "2500" 3) (nil "821004201" "2500" 3)
(nil "825002022" "" 6) (101 "825084000" "2305" 1))
(mapcar '(lambda (z) (list (nth 0 z) (nth 1 z) (nth 2 z) (nth 3 z)))
(ssg-sl-opt plan "zeilen")))
(tsl-eq "lauf 1: 4 fahnen" 4 (ssg-sl-opt (cadr erg) "fahnen"))
(tsl-eq "lauf 1: konsistent" T (tsl-lauf-konsistent-p lauf))
(setq e (tsl-fahne-zu s2))
(tsl-eq "saeule: nummer der ersten art.-nr." "100" (tsl-text e))
(tsl-eq "saeule: layer D-1-POS" "D-1-POS" (cdr (assoc 8 (entget e))))
(tsl-eq "saeule: zielpunkt einfuegepunkt" '(3000.0 0.0 6000.0) (tsl-zielpunkt e))
(tsl-eq "fahne: rahmen um den text" :vlax-true
(vla-get-TextFrameDisplay (vlax-ename->vla-object e)))
(tsl-eq "fahne: textstil Pos" "Pos" (vla-get-TextStyleName (vlax-ename->vla-object e)))
(setq e (tsl-fahne-zu t1))
(tsl-eq "traeger: nummer fortlaufend ueber layer" "101" (tsl-text e))
(tsl-eq "traeger: layer D-5-POS" "D-5-POS" (cdr (assoc 8 (entget e))))
(tsl-eq "traeger 0 grad: zielpunkt mitte" '(1152.5 1000.0 6000.0) (tsl-zielpunkt e))
(tsl-eq "block ohne attribute: keine fahne" nil (tsl-fahne-zu pf))
(setq tbo1 (tsl-tabelle lauf))
(tsl-eq "lauf 1: tabelle zeilen" 6 (vla-get-Rows tbo1))
(tsl-eq "lauf 1: titel" "TSL_TITEL" (vla-GetText tbo1 0 0))
(tsl-eq "lauf 1: kopf laenge" (strcat "L" (chr 228) "nge") (vla-GetText tbo1 1 2))
(tsl-eq "lauf 1: baugruppenzeile" '("100" "3" "2500" "821006051") (tsl-zeile tbo1 2))
(tsl-eq "lauf 1: unterzeile ohne nummer" '("" "3" "2500" "821004201") (tsl-zeile tbo1 3))
(tsl-eq "lauf 1: anbauteil ohne nummer/laenge" '("" "6" "" "825002022") (tsl-zeile tbo1 4))
(tsl-eq "lauf 1: tabellen-layer" (cdr (assoc "tabellen_layer" cfg)) (vla-get-Layer tbo1))
;; ============ Lauf 2: alle gewaehlt, positionierte uebersprungen ============
(tsl-eq "lauf 2: letzte nummer" 101 (ssg-sl-letzte-nummer))
(setq opt (ssg-sl-optionen-start cfg (ssg-sl-letzte-nummer)))
(tsl-eq "lauf 2: startnummer-vorschlag" 102 (ssg-sl-opt opt "startnr"))
(setq rand (ssg-sl-tabellen-vorschlag 500.0))
(vla-GetBoundingBox tbo1 'mn 'mx)
(tsl-eq "lauf 2: tabellenvorschlag rechts neben lauf 1" T
(if (and rand (> (car rand) (car (vlax-safearray->list mx)))) T nil))
(setq erg (tsl-lauf elemente cfg nil rand))
(setq plan (car erg) lauf (ssg-sl-opt plan "lauf"))
(tsl-eq "lauf 2: 4 uebersprungen" 4 (ssg-sl-opt plan "uebersprungen"))
(tsl-eq "lauf 2: nur der neue traeger" 1 (length (ssg-sl-opt plan "recs")))
(tsl-eq "lauf 2: nummer fortlaufend" "102" (tsl-text (tsl-fahne-zu t2)))
(tsl-eq "traeger 90 grad: zielpunkt mitte" '(10000.0 1152.5 6000.0)
(tsl-zielpunkt (tsl-fahne-zu t2)))
(tsl-eq "lauf 2: konsistent" T (tsl-lauf-konsistent-p lauf))
(tsl-eq "lauf 2: zwei tabellen" 2 (length (ssg-sl-tabellen)))
(tsl-eq "lauf 2: lauf 1 unveraendert" "100" (tsl-text (tsl-fahne-zu s2)))
(tsl-eq "lauf 2: 5 fahnen gesamt" 5 (length (ssg-sl-fahnen)))
;; ============ Lauf 3: nur schon positionierte Teile ============
(setq erg (tsl-lauf (list s1 t2) cfg nil '(0.0 -9000.0 0.0)))
(tsl-eq "lauf 3: nichts zu tun" nil (ssg-sl-opt (car erg) "recs"))
(tsl-eq "lauf 3: keine weitere tabelle" 2 (length (ssg-sl-tabellen)))
;; ============ Lauf 4: alle Positionen in der Fahne ============
(setq s4 (tsl-insert saeule "D-1" '(0.0 20000.0 0.0) 0.0 (tsl-saeule-werte)))
(setq s5 (tsl-insert saeule "D-1" '(3000.0 20000.0 0.0) 0.0 (tsl-saeule-werte)))
(setq t3 (tsl-insert traeger "D-5" '(0.0 22000.0 0.0) 0.0 (tsl-traeger-werte)))
(setq erg (tsl-lauf (list s4 s5 t3) cfg (list (cons "alle_pos" T))
(ssg-sl-tabellen-vorschlag 500.0)))
(setq plan (car erg) lauf (ssg-sl-opt plan "lauf"))
(tsl-eq "lauf 4: jede art.-nr. nummeriert"
'((103 "821004201" "2500" 2) (104 "821006051" "2500" 2)
(105 "825002022" "" 4) (106 "825084000" "2305" 1))
(mapcar '(lambda (z) (list (nth 0 z) (nth 1 z) (nth 2 z) (nth 3 z)))
(ssg-sl-opt plan "zeilen")))
(tsl-eq "lauf 4: fahne mit allen nummern" "104|103|105" (tsl-text (tsl-fahne-zu s4)))
(tsl-eq "lauf 4: traeger" "106" (tsl-text (tsl-fahne-zu t3)))
(tsl-eq "lauf 4: konsistent" T (tsl-lauf-konsistent-p lauf))
(tsl-eq "lauf 4: drei tabellen" 3 (length (ssg-sl-tabellen)))
(tsl-eq "lauf 4: letzte nummer" 106 (ssg-sl-letzte-nummer))
;; ============ Lauf 5: Tabelle scheitert -> Lauf zurueckgenommen ============
(setq t4 (tsl-insert traeger "D-5" '(0.0 30000.0 0.0) 0.0 (tsl-traeger-werte)))
(setq erg (tsl-lauf (list t4) cfg nil nil))
(tsl-eq "lauf 5: nicht ok" nil (ssg-sl-opt (cadr erg) "ok"))
(tsl-eq "lauf 5: keine fahne fuer t4" nil (tsl-fahne-zu t4))
(tsl-eq "lauf 5: fahnen unveraendert" 8 (length (ssg-sl-fahnen)))
(tsl-eq "lauf 5: tabellen unveraendert" 3 (length (ssg-sl-tabellen)))
;; ============ Lauf 6: gesperrter Ziel-Layer ============
(command "_.-LAYER" "_LO" "D-5-POS" "")
(setq opt (ssg-sl-optionen-start cfg (ssg-sl-letzte-nummer))
plan (ssg-sl-vorbereiten (list t4) opt cfg))
(tsl-eq "lauf 6: gesperrter layer gemeldet" '("D-5-POS") (ssg-sl-gesperrte-layer plan opt))
(command "_.-LAYER" "_U" "D-5-POS" "")
;; t4 ist nach dem gescheiterten Lauf weiter positionierbar
(setq erg (tsl-lauf (list t4) cfg nil (ssg-sl-tabellen-vorschlag 500.0)))
(tsl-eq "lauf 6: t4 danach positioniert" "107" (tsl-text (tsl-fahne-zu t4)))
(tsl-eq "lauf 6: konsistent" T (tsl-lauf-konsistent-p (ssg-sl-opt (car erg) "lauf")))
(princ))
(defun stueckliste:export-results (out-dir / f pfad)
(setq pfad (strcat out-dir "/stueckliste_results.json"))
(setq f (open pfad "w"))
(if f
(progn
(write-line "{" f)
(write-line (strcat " \"pass\": " (itoa *tsl-pass*) ",") f)
(write-line (strcat " \"fail\": " (itoa *tsl-fail*) ",") f)
(write-line (strcat " \"status\": \""
(if (= *tsl-fail* 0) "OK" "FEHLER") "\"") f)
(write-line "}" f)
(close f)
(princ (strcat "\n Ergebnis: " pfad))))
(princ))
(defun c:TEST_STUECKLISTE ( / res)
(setq *tsl-pass* 0 *tsl-fail* 0 *tsl-fails* '())
(princ "\n================================================================")
(princ "\n TEST_STUECKLISTE - Positionen + Stueckliste (ssg_stueckliste.lsp)")
(princ "\n================================================================")
(setq res (vl-catch-all-apply 'stueckliste:tests nil))
(if (vl-catch-all-error-p res)
(progn (setq *tsl-fail* (1+ *tsl-fail*))
(setq *tsl-fails* (cons (strcat "harter Fehler: " (vl-catch-all-error-message res))
*tsl-fails*))))
(princ "\n\n----------------------------------------------------------------")
(princ (strcat "\n Ergebnis: " (itoa *tsl-pass*) " PASS, "
(itoa *tsl-fail*) " FAIL"))
(if (> *tsl-fail* 0)
(progn
(princ "\n Fehlgeschlagen:")
(foreach n (reverse *tsl-fails*) (princ (strcat "\n - " n)))))
(princ "\n================================================================")
(princ))
(princ "\nTEST_STUECKLISTE geladen. Aufruf: TEST_STUECKLISTE")
(princ)