[FIX] Lagerbereiche für GOH werden nun korrekt gezählt und in die yaml geschrieben
This commit is contained in:
Simon Hensch committed
1 parent
d9043ebca5
commit
b324362351
14 files changed
+98
-615
No files matched your search
+46
-415
@@ -11,8 +11,6 @@
|
||||
;; LG_REIHE_<L>_<T> Regalreihe (Rechteck L x T + Schienenlinie)
|
||||
;; LG_GANG_<L>_<B>_<BELAG> Gang/Quergang/Randgang (Rechteck L x B, Schraffur
|
||||
;; je Belag aus lager.json belag_schraffur)
|
||||
;; goh_rack parametrischer BricsCAD-Block (Bestand), wird als
|
||||
;; Regalreihe mitgezaehlt (lg-racks-sammeln)
|
||||
;;
|
||||
;; Befehle: LG_GESCHOSS, LG_GESCHOSS_AKTIV, LG_GESCHOSS_KOPIEREN, LG_BEREICH,
|
||||
;; LG_REIHE, LG_GANG, LG_EDIT, LG_REGALE, LAGER_EXPORT, LAGER_HAND_YAML
|
||||
@@ -132,16 +130,6 @@
|
||||
";")
|
||||
)
|
||||
|
||||
;; Haengeebenen auf n Ebenen begrenzen (goh_rack kennt nur die Anzahl):
|
||||
;; die obersten n der Vorgabe. Fehlen Ebenen in der Vorgabe, bleibt es bei
|
||||
;; dem, was da ist.
|
||||
(defun lg-haengeebenen-n (s n / ebenen erg i)
|
||||
(setq ebenen (lg-haengeebenen-parse s) erg nil i 0)
|
||||
(while (and ebenen (< i n))
|
||||
(setq erg (cons (car ebenen) erg) ebenen (cdr ebenen) i (1+ i)))
|
||||
(lg-haengeebenen-string (reverse erg))
|
||||
)
|
||||
|
||||
;; Feldwert pruefen/normalisieren. art: "mm" (Zahl >= 0), "mm_leer" (wie mm,
|
||||
;; leer erlaubt), "int" (ganze Zahl >= 1), "int0" (>= 0), "grad" (beliebige
|
||||
;; Zahl), "mm_vz" (mm mit Vorzeichen, z.B. Versatz), "text", "ebenen"
|
||||
@@ -1427,261 +1415,14 @@
|
||||
)
|
||||
|
||||
;; ============================================================
|
||||
;; GOH_RACK-ERKENNUNG (lg-racks-sammeln, Befehl LG_REGALE)
|
||||
;; REGALE ZAEHLEN (LG_REGALE)
|
||||
;; ============================================================
|
||||
;; goh_rack ist ein parametrischer BricsCAD-Block (MCAD-Parametrik), KEIN
|
||||
;; AutoCAD-Dynamikblock: seine Referenzen tragen einen anonymen Namen
|
||||
;; ("*U29"), IsDynamicBlock ist FALSE, und der echte Name sowie die
|
||||
;; Parameter stehen nur in den Objekteigenschaften:
|
||||
;; (getpropertyvalue ent "EffectiveName") -> "goh_rack"
|
||||
;; (getpropertyvalue ent "Laenge~MCAD") -> "7187.52 mm"
|
||||
;; Gefunden werden Racks direkt im Modellbereich, in assoziativen Arrays
|
||||
;; (anonymer Block mit Referenzen), in MINSERT-Rastern und in beliebig
|
||||
;; verschachtelten Bloecken (bis *lg-rack-max-tiefe*). Blockname und
|
||||
;; Parameternamen aus lager.json "goh_rack".
|
||||
;; Ergebnis je Rack: (name laenge-mm ebenen mitte top-ent), Zugriff ueber
|
||||
;; lg-rk-*. top-ent = oberstes INSERT im Modellbereich, in dem das Rack
|
||||
;; steckt (bei einem direkt eingefuegten Rack es selbst) - ueber dessen
|
||||
;; Layer _G<nr> ordnet lg-rack-geschoss das Geschoss zu.
|
||||
|
||||
(setq *lg-rack-max-tiefe* 8)
|
||||
|
||||
(defun lg-rk-name (r) (nth 0 r))
|
||||
(defun lg-rk-laenge (r) (nth 1 r))
|
||||
(defun lg-rk-ebenen (r) (nth 2 r))
|
||||
(defun lg-rk-mitte (r) (nth 3 r))
|
||||
(defun lg-rk-top (r) (nth 4 r))
|
||||
|
||||
;; Reiner Kern: Zahl aus einem Parameterwert. MCAD-Parameter kommen als
|
||||
;; Text mit Einheit ("700 mm", "71.8752 cm", "12.9 m") - auf mm umgerechnet;
|
||||
;; ohne Einheit unveraendert. Unbekannte Einheit/kein Zahlanfang -> nil.
|
||||
(defun lg-zahl-einheit (v / s i c ziffern zahl rest faktor)
|
||||
(cond
|
||||
((numberp v) (float v))
|
||||
((= (type v) 'STR)
|
||||
(setq s (vl-string-translate "," "." (vl-string-trim " \t\r\n" v))
|
||||
i 1 ziffern "")
|
||||
(while (and (<= i (strlen s))
|
||||
(setq c (substr s i 1))
|
||||
(or (wcmatch c "#") (member c '("." "-" "+"))))
|
||||
(setq ziffern (strcat ziffern c) i (1+ i)))
|
||||
(setq zahl (if (/= ziffern "") (distof ziffern 2))
|
||||
rest (strcase (vl-string-trim " \t" (substr s i)))
|
||||
faktor (cdr (assoc rest '(("" . 1.0) ("MM" . 1.0) ("CM" . 10.0) ("DM" . 100.0) ("M" . 1000.0)))))
|
||||
(if (and zahl faktor) (* zahl faktor)))
|
||||
(T nil))
|
||||
)
|
||||
|
||||
;; Reiner Kern: ein echter Blockname (nicht leer, nicht anonym "*U..").
|
||||
(defun lg-name-brauchbar-p (s)
|
||||
(if (and (= (type s) 'STR) (/= s "") (/= (substr s 1 1) "*")) T)
|
||||
)
|
||||
|
||||
;; Objekteigenschaft lesen, nil wenn es sie nicht gibt.
|
||||
(defun lg-prop (ent name / r)
|
||||
(setq r (vl-catch-all-apply 'getpropertyvalue (list ent name)))
|
||||
(if (vl-catch-all-error-p r) nil r)
|
||||
)
|
||||
|
||||
;; Name, unter dem eine Referenz gefuehrt wird: Objekteigenschaft
|
||||
;; EffectiveName (auch fuer MCAD-Bloecke), sonst ActiveX-EffectiveName,
|
||||
;; sonst DXF-Blockname.
|
||||
(defun lg-rack-name (ent / n)
|
||||
(cond
|
||||
((lg-name-brauchbar-p (setq n (lg-prop ent "EffectiveName"))) n)
|
||||
(T (lg-blockname ent)))
|
||||
)
|
||||
|
||||
(defun lg-rack-p (ent / n)
|
||||
(setq n (lg-rack-name ent))
|
||||
(and n (= (strcase n) (strcase *lg-rack-suchname*)))
|
||||
)
|
||||
|
||||
;; MCAD-Parameter (Kennung "<Name>~MCAD" in listallproperties, Gross-/
|
||||
;; Kleinschreibung egal).
|
||||
(defun lg-mcad-param (ent name / props id soll)
|
||||
(setq props (vl-catch-all-apply 'listallproperties (list ent))
|
||||
soll (strcase (strcat name "~MCAD")))
|
||||
(if (and (not (vl-catch-all-error-p props)) (listp props)
|
||||
(setq id (vl-some '(lambda (p / s)
|
||||
(setq s (vl-princ-to-string p))
|
||||
(if (= (strcase s) soll) s))
|
||||
props)))
|
||||
(lg-prop ent id))
|
||||
)
|
||||
|
||||
;; Dynamische Blockeigenschaft (AutoCAD-Dynamikbloecke).
|
||||
(defun lg-dyn-param (ent name / r)
|
||||
(setq r (vl-catch-all-apply
|
||||
'(lambda ( / obj)
|
||||
(setq obj (vlax-ename->vla-object ent))
|
||||
(if (and (vlax-property-available-p obj 'IsDynamicBlock)
|
||||
(= :vlax-true (vla-get-IsDynamicBlock obj)))
|
||||
(vl-some '(lambda (p)
|
||||
(if (= (strcase (vla-get-PropertyName p)) (strcase name))
|
||||
(vlax-variant-value (vla-get-Value p))))
|
||||
(vlax-invoke obj 'GetDynamicBlockProperties))))))
|
||||
(if (vl-catch-all-error-p r) nil r)
|
||||
)
|
||||
|
||||
;; Parameterwert einer Referenz: MCAD-Parameter vor dynamischer
|
||||
;; Eigenschaft vor Attribut vor konstanter ATTDEF-Vorgabe.
|
||||
(defun lg-rack-param (ent name / w)
|
||||
(cond
|
||||
((setq w (lg-mcad-param ent name)) w)
|
||||
((setq w (lg-dyn-param ent name)) w)
|
||||
((setq w (lg-wert-fuer-tag name (ssg-attrib-read ent))) w)
|
||||
((lg-wert-fuer-tag name
|
||||
(mapcar '(lambda (ed) (cons (cdr (assoc 2 ed)) (cdr (assoc 1 ed))))
|
||||
(vl-remove-if-not '(lambda (ed) (= (cdr (assoc 0 ed)) "ATTDEF"))
|
||||
(lg-blockdef-objekte (cdr (assoc 2 (entget ent))))))))
|
||||
)
|
||||
)
|
||||
|
||||
;; --- Transformationen: tf = (ursprung x-achse y-achse z-achse), Achsen
|
||||
;; mit Skalierung; p' = o + px*ax + py*ay + pz*az (rein, getestet) ---
|
||||
(defun lg-v3 (p) (list (float (car p)) (float (cadr p)) (if (caddr p) (float (caddr p)) 0.0)))
|
||||
(defun lg-v+ (a b) (mapcar '+ a b))
|
||||
(defun lg-v* (v k) (mapcar '(lambda (x) (* x k)) v))
|
||||
(defun lg-tf-id () '((0.0 0.0 0.0) (1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0)))
|
||||
(defun lg-tf-vek (tf v / v3)
|
||||
(setq v3 (lg-v3 v))
|
||||
(lg-v+ (lg-v* (nth 1 tf) (car v3)) (lg-v+ (lg-v* (nth 2 tf) (cadr v3)) (lg-v* (nth 3 tf) (caddr v3))))
|
||||
)
|
||||
(defun lg-tf-pkt (tf p) (lg-v+ (car tf) (lg-tf-vek tf p)))
|
||||
;; innen ist im System von aussen beschrieben -> Gesamttransformation
|
||||
(defun lg-tf-verketten (aussen innen)
|
||||
(list (lg-tf-pkt aussen (car innen)) (lg-tf-vek aussen (nth 1 innen))
|
||||
(lg-tf-vek aussen (nth 2 innen)) (lg-tf-vek aussen (nth 3 innen)))
|
||||
)
|
||||
|
||||
(defun lg-skal (s) (if (and s (not (equal s 0.0 1e-12))) s 1.0))
|
||||
|
||||
;; Transformation einer INSERT (entget-Liste) im System ihres Containers.
|
||||
;; sp/zl = MINSERT-Spalte/-Zeile (0/0 = Basis). Beruecksichtigt Extrusion
|
||||
;; (210), Drehung, Skalierung, Rasterabstaende (44/45, entlang der
|
||||
;; gedrehten Achsen) und den Basispunkt der Blockdefinition.
|
||||
(defun lg-insert-tf (ed sp zl / nor rot ax ay az xr yr o bp)
|
||||
(setq nor (lg-v3 (cond ((cdr (assoc 210 ed))) ('(0.0 0.0 1.0))))
|
||||
rot (cond ((cdr (assoc 50 ed))) (0.0)))
|
||||
(if (equal nor '(0.0 0.0 1.0) 1e-12)
|
||||
(setq ax '(1.0 0.0 0.0) ay '(0.0 1.0 0.0) az '(0.0 0.0 1.0))
|
||||
(setq ax (lg-v3 (trans '(1.0 0.0 0.0) nor 0 T))
|
||||
ay (lg-v3 (trans '(0.0 1.0 0.0) nor 0 T))
|
||||
az (lg-v3 (trans '(0.0 0.0 1.0) nor 0 T))))
|
||||
(setq xr (lg-v+ (lg-v* ax (cos rot)) (lg-v* ay (sin rot)))
|
||||
yr (lg-v+ (lg-v* ax (- (sin rot))) (lg-v* ay (cos rot)))
|
||||
o (lg-tf-pkt (list '(0.0 0.0 0.0) ax ay az) (cdr (assoc 10 ed)))
|
||||
o (lg-v+ o (lg-v+ (lg-v* xr (* sp (cond ((cdr (assoc 44 ed))) (0.0))))
|
||||
(lg-v* yr (* zl (cond ((cdr (assoc 45 ed))) (0.0)))))))
|
||||
(setq xr (lg-v* xr (lg-skal (cdr (assoc 41 ed))))
|
||||
yr (lg-v* yr (lg-skal (cdr (assoc 42 ed))))
|
||||
az (lg-v* az (lg-skal (cdr (assoc 43 ed))))
|
||||
bp (lg-v3 (cond ((cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 ed)))))) ('(0.0 0.0 0.0)))))
|
||||
;; der Basispunkt der Definition liegt auf dem Einfuegepunkt
|
||||
(list (lg-v+ o (lg-v* (lg-tf-vek (list nil xr yr az) bp) -1.0)) xr yr az)
|
||||
)
|
||||
|
||||
;; Bounding-Box (min max) eines Objekts in den Koordinaten seines
|
||||
;; Containers, nil wenn nicht ermittelbar.
|
||||
(defun lg-bbox (ent / r)
|
||||
(setq r (vl-catch-all-apply
|
||||
'(lambda ( / ll ur)
|
||||
(vla-GetBoundingBox (vlax-ename->vla-object ent) 'll 'ur)
|
||||
(list (lg-v3 (vlax-safearray->list ll)) (lg-v3 (vlax-safearray->list ur))))))
|
||||
(if (vl-catch-all-error-p r) nil r)
|
||||
)
|
||||
|
||||
;; Enthaelt die Blockdefinition (rekursiv) ein Rack? Gemerkt in
|
||||
;; *lg-rack-cache*, Zirkelschutz ueber *lg-rack-pfad*, XRefs ausgenommen.
|
||||
(defun lg-rack-enthaelt-p (bname tiefe / k vorh def res)
|
||||
(setq k (strcase bname))
|
||||
(cond
|
||||
((setq vorh (assoc k *lg-rack-cache*)) (cdr vorh))
|
||||
((or (>= tiefe *lg-rack-max-tiefe*) (member k *lg-rack-pfad*)) nil)
|
||||
(T
|
||||
(setq def (tblsearch "BLOCK" bname) res nil)
|
||||
(if (and def (= 0 (logand (cond ((cdr (assoc 70 def))) (0)) 4)))
|
||||
(progn
|
||||
(setq *lg-rack-pfad* (cons k *lg-rack-pfad*))
|
||||
(setq res (vl-some '(lambda (ed)
|
||||
(if (= (cdr (assoc 0 ed)) "INSERT")
|
||||
(or (lg-rack-p (cdr (assoc -1 ed)))
|
||||
(lg-rack-enthaelt-p (cdr (assoc 2 ed)) (1+ tiefe)))))
|
||||
(lg-blockdef-objekte bname)))
|
||||
(setq *lg-rack-pfad* (cdr *lg-rack-pfad*))))
|
||||
(setq *lg-rack-cache* (cons (cons k res) *lg-rack-cache*))
|
||||
res))
|
||||
)
|
||||
|
||||
;; Eine INSERT pruefen (inkl. MINSERT-Raster) bzw. in ihre Definition
|
||||
;; absteigen. ptf = Transformation des Containers nach Welt.
|
||||
(defun lg-rack-insert (ent ptf tiefe top / ed spalten zeilen raster sp zl ctf bb name laenge ebenen)
|
||||
(setq ed (entget ent)
|
||||
spalten (max 1 (cond ((cdr (assoc 70 ed))) (1)))
|
||||
zeilen (max 1 (cond ((cdr (assoc 71 ed))) (1)))
|
||||
raster (> (* spalten zeilen) 1))
|
||||
(cond
|
||||
((lg-rack-p ent)
|
||||
(setq name (lg-rack-name ent)
|
||||
laenge (lg-zahl-einheit (lg-rack-param ent *lg-rack-param-laenge*))
|
||||
ebenen (lg-zahl-einheit (lg-rack-param ent *lg-rack-param-ebenen*))
|
||||
bb (if (not raster) (lg-bbox ent))
|
||||
sp 0)
|
||||
(repeat spalten
|
||||
(setq zl 0)
|
||||
(repeat zeilen
|
||||
(setq *lg-racks*
|
||||
(cons (list name laenge ebenen
|
||||
(if bb
|
||||
(lg-tf-pkt ptf (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (car bb) (cadr bb)))
|
||||
(car (lg-tf-verketten ptf (lg-insert-tf ed sp zl))))
|
||||
top)
|
||||
*lg-racks*)
|
||||
zl (1+ zl)))
|
||||
(setq sp (1+ sp))))
|
||||
((and (< tiefe *lg-rack-max-tiefe*) (lg-rack-enthaelt-p (cdr (assoc 2 ed)) 0))
|
||||
(setq sp 0)
|
||||
(repeat spalten
|
||||
(setq zl 0)
|
||||
(repeat zeilen
|
||||
(setq ctf (lg-tf-verketten ptf (lg-insert-tf ed sp zl)))
|
||||
(foreach sub (lg-blockdef-objekte (cdr (assoc 2 ed)))
|
||||
(if (= (cdr (assoc 0 sub)) "INSERT")
|
||||
(lg-rack-insert (cdr (assoc -1 sub)) ctf (1+ tiefe) top)))
|
||||
(setq zl (1+ zl)))
|
||||
(setq sp (1+ sp))))
|
||||
)
|
||||
)
|
||||
|
||||
;; Alle goh_racks im Modellbereich (Blockname/Parameter aus lager.json).
|
||||
;; Rueckgabe: Liste (name laenge-mm ebenen mitte top-ent), Fundreihenfolge.
|
||||
(defun lg-racks-sammeln ( / )
|
||||
(lg-racks-finden (lg-vorgabe '("goh_rack" "blockname") "goh_rack")
|
||||
(lg-vorgabe '("goh_rack" "param_laenge") "Laenge")
|
||||
(lg-vorgabe '("goh_rack" "param_ebenen") "Ebenen"))
|
||||
)
|
||||
|
||||
;; Wie lg-racks-sammeln, Blockname und Parameternamen als Argument.
|
||||
(defun lg-racks-finden (name p-laenge p-ebenen / ss i)
|
||||
(setq *lg-rack-suchname* name
|
||||
*lg-rack-param-laenge* p-laenge
|
||||
*lg-rack-param-ebenen* p-ebenen
|
||||
*lg-racks* nil *lg-rack-cache* nil *lg-rack-pfad* nil)
|
||||
(if (setq ss (ssget "_X" '((0 . "INSERT") (410 . "Model"))))
|
||||
(progn
|
||||
(setq i 0)
|
||||
(repeat (sslength ss)
|
||||
(lg-rack-insert (ssname ss i) (lg-tf-id) 0 (ssname ss i))
|
||||
(setq i (1+ i)))))
|
||||
(reverse *lg-racks*)
|
||||
)
|
||||
|
||||
;; Reiner Kern: Racks je Geschoss zusammenfassen. eintraege = ((geschoss
|
||||
;; Reiner Kern: Regalreihen je Geschoss zusammenfassen. eintraege = ((geschoss
|
||||
;; laenge-mm ebenen) ...), geschoss nil = nicht zuordenbar, fehlende Laenge/
|
||||
;; Ebenen zaehlen 0. Rueckgabe ((geschoss anzahl summe-laenge
|
||||
;; summe-laenge-x-ebenen) ...), nach Geschoss sortiert, nil zuletzt.
|
||||
(defun lg-racks-auswerten (eintraege / erg vorh l k)
|
||||
(defun lg-reihen-auswerten (eintraege / erg vorh l k)
|
||||
(setq erg nil)
|
||||
(foreach x eintraege
|
||||
(setq l (cond ((cadr x)) (0.0))
|
||||
@@ -1693,30 +1434,39 @@
|
||||
(vl-sort erg '(lambda (a b) (cond ((null (car a)) nil) ((null (car b)) T) (T (< (car a) (car b))))))
|
||||
)
|
||||
|
||||
;; Befehl LG_REGALE: goh_racks zaehlen, Anzahl, Laenge und Laenge x Ebenen
|
||||
;; (Haengekapazitaet) je Geschoss in der Befehlszeile.
|
||||
(defun c:LG_REGALE ( / kand racks zeilen ohne-laenge)
|
||||
(setq kand (lg-geschoss-kandidaten)
|
||||
racks (lg-racks-sammeln))
|
||||
(if (null racks)
|
||||
(princ (ssg-textf "lg-regale-keine" (list (lg-vorgabe '("goh_rack" "blockname") "goh_rack"))))
|
||||
(progn
|
||||
(setq zeilen (lg-racks-auswerten
|
||||
(mapcar '(lambda (r) (list (lg-rack-geschoss (lg-ent-layer (lg-rk-top r)) (lg-rk-mitte r) kand)
|
||||
(lg-rk-laenge r) (lg-rk-ebenen r)))
|
||||
racks))
|
||||
ohne-laenge (length (vl-remove-if 'lg-rk-laenge racks)))
|
||||
(princ (ssg-text "lg-regale-kopf"))
|
||||
(foreach z zeilen
|
||||
(princ (ssg-textf "lg-regale-zeile"
|
||||
(list (if (car z) (ssg-textf "lg-regale-geschoss" (list (itoa (car z))))
|
||||
(ssg-text "lg-regale-ohne-geschoss"))
|
||||
(itoa (cadr z)) (rtos (/ (caddr z) 1000.0) 2 2) (rtos (/ (cadddr z) 1000.0) 2 2)))))
|
||||
(princ (ssg-textf "lg-regale-zeile"
|
||||
(list (ssg-text "lg-regale-summe") (itoa (length racks))
|
||||
(rtos (/ (apply '+ (mapcar 'caddr zeilen)) 1000.0) 2 2)
|
||||
(rtos (/ (apply '+ (mapcar 'cadddr zeilen)) 1000.0) 2 2))))
|
||||
(if (> ohne-laenge 0) (princ (ssg-textf "lg-regale-ohne-laenge" (list (itoa ohne-laenge)))))))
|
||||
;; Reiner Kern: Eintrag (geschoss laenge-mm ebenen) einer Regalreihe
|
||||
;; (LG_REIHE_*) fuer lg-reihen-auswerten, aus ihren Attributen. Ebenen =
|
||||
;; Anzahl der Haengeebenen in HAENGEEBENEN, Geschoss nil wenn nicht lesbar.
|
||||
(defun lg-reihe-eintrag (a / gs)
|
||||
(setq gs (lg-zahl (cdr (assoc "GESCHOSS" a))))
|
||||
(list (if gs (fix gs))
|
||||
(lg-zahl (cdr (assoc "LAENGE" a)))
|
||||
(float (length (lg-haengeebenen-parse (cdr (assoc "HAENGEEBENEN" a))))))
|
||||
)
|
||||
|
||||
;; Zeilen von lg-reihen-auswerten in der Befehlszeile ausgeben (Kopf, je
|
||||
;; Geschoss eine Zeile, Summe). zeile-key: Textschluessel mit %1..%4.
|
||||
(defun lg-regale-ausgeben (kopf-key zeile-key zeilen)
|
||||
(princ (ssg-text kopf-key))
|
||||
(foreach z zeilen
|
||||
(princ (ssg-textf zeile-key
|
||||
(list (if (car z) (ssg-textf "lg-regale-geschoss" (list (itoa (car z))))
|
||||
(ssg-text "lg-regale-ohne-geschoss"))
|
||||
(itoa (cadr z)) (rtos (/ (caddr z) 1000.0) 2 2) (rtos (/ (cadddr z) 1000.0) 2 2)))))
|
||||
(princ (ssg-textf zeile-key
|
||||
(list (ssg-text "lg-regale-summe") (itoa (apply '+ (mapcar 'cadr zeilen)))
|
||||
(rtos (/ (apply '+ (mapcar 'caddr zeilen)) 1000.0) 2 2)
|
||||
(rtos (/ (apply '+ (mapcar 'cadddr zeilen)) 1000.0) 2 2))))
|
||||
)
|
||||
|
||||
;; Befehl LG_REGALE: Regalreihen (LG_REIHE_* aus LG_BEREICH/LG_REIHE)
|
||||
;; zaehlen - je Geschoss Anzahl, Laenge und Laenge x Ebenen
|
||||
;; (Haengekapazitaet) in der Befehlszeile.
|
||||
(defun c:LG_REGALE ( / reihen)
|
||||
(if (setq reihen (lg-alle-bloecke "LG_REIHE_*"))
|
||||
(lg-regale-ausgeben "lg-regale-kopf" "lg-regale-zeile"
|
||||
(lg-reihen-auswerten (mapcar '(lambda (e) (lg-reihe-eintrag (ssg-attrib-read e))) reihen)))
|
||||
(princ (ssg-text "lg-regale-keine")))
|
||||
(princ)
|
||||
)
|
||||
|
||||
@@ -1730,40 +1480,11 @@
|
||||
;; normalen Einfuegefunktionen NEU erzeugt (Layer, ID, Verknuepfung,
|
||||
;; Blockname/Schraffur, ATTSYNC kommen von dort) - die Kinder 1:1 aus der
|
||||
;; Quelle, ohne Neufuellen, damit Handaenderungen (auto_geaendert, manuelle
|
||||
;; Reihen/Gaenge) erhalten bleiben. goh_rack-Bloecke (parametrisch) werden
|
||||
;; per vla-Copy kopiert und auf den Regal-Layer des Zielgeschosses gelegt.
|
||||
;; Reihen/Gaenge) erhalten bleiben.
|
||||
;; Die Kopie liegt deckungsgleich (2D uebereinander), optional je Kopie um
|
||||
;; (dx dy) versetzt; in einer 3D-Zeichnung (Konturen auf Belagshoehe)
|
||||
;; zusaetzlich in Z um den Hoehenabstand.
|
||||
|
||||
;; Layer eines Objekts oder nil.
|
||||
(defun lg-ent-layer (ent / ed)
|
||||
(if (and ent (setq ed (entget ent))) (cdr (assoc 8 ed)))
|
||||
)
|
||||
|
||||
;; Reiner Kern: Geschossnummer aus einem Lager-Layer "LG_<x>_G<nr>"
|
||||
;; (Muster wie lg-geschoss-aktivieren), sonst nil.
|
||||
(defun lg-geschoss-aus-layer (name / s p rest)
|
||||
(if (and (= (type name) 'STR) (wcmatch (setq s (strcase name)) "LG_*_G#*"))
|
||||
(progn
|
||||
(setq p (vl-string-position (ascii "_") s nil T)
|
||||
rest (substr s (+ p 2)))
|
||||
(if (and (> (strlen rest) 1) (= (substr rest 1 1) "G")
|
||||
(vl-every '(lambda (c) (<= 48 c 57)) (vl-string->list (substr rest 2))))
|
||||
(atoi (substr rest 2)))))
|
||||
)
|
||||
|
||||
;; Reiner Kern: Geschoss eines goh_rack. Ein Lager-Layer _G<nr> eines
|
||||
;; vorhandenen Geschosses entscheidet (eindeutig auch bei 2D-Geschossen
|
||||
;; uebereinander), sonst die Kontur (lg-geschoss-fuer-punkt-kern).
|
||||
;; kandidaten = ((nr hoehe-mm kontur-punkte) ...)
|
||||
(defun lg-rack-geschoss (layer pt kandidaten / n)
|
||||
(setq n (lg-geschoss-aus-layer layer))
|
||||
(if (and n (assoc n kandidaten))
|
||||
n
|
||||
(lg-geschoss-fuer-punkt-kern pt kandidaten))
|
||||
)
|
||||
|
||||
;; Reiner Kern: Belag eines kopierten Bereichs/Gangs. Entsprach er dem
|
||||
;; Geschossbelag der Quelle, folgt er dem neuen Geschossbelag; bewusst
|
||||
;; abweichende (z.B. Gitterrost-Gang auf Spanplatte-Buehne) bleiben.
|
||||
@@ -1847,59 +1568,9 @@
|
||||
(if (setq neu (lg-kontur-kopieren ent)) (lg-ent-verschieben neu v))
|
||||
)
|
||||
|
||||
;; goh_rack-Bloecke des Geschosses src als oberste INSERTs im Modellbereich
|
||||
;; (ein Array mit Racks zaehlt als ein Objekt). Vor der ersten Kopie
|
||||
;; aufrufen: danach waere die Kontur-Zuordnung deckungsgleicher Geschosse
|
||||
;; mehrdeutig. Rueckgabe: (racks anzahl-mehrdeutig)
|
||||
(defun lg-racks-der-quelle (src kandidaten / src-pts racks mehrdeutig top gs)
|
||||
(setq racks nil mehrdeutig nil
|
||||
src-pts (caddr (assoc src kandidaten)))
|
||||
(foreach r (lg-racks-sammeln)
|
||||
(setq top (lg-rk-top r)
|
||||
gs (lg-rack-geschoss (lg-ent-layer top) (lg-rk-mitte r) kandidaten))
|
||||
(cond
|
||||
((and gs (= gs src))
|
||||
(if (not (member top racks)) (setq racks (cons top racks))))
|
||||
((and (null gs) src-pts (ssg-punkt-in-poly-p (lg-rk-mitte r) src-pts))
|
||||
(if (not (member top mehrdeutig)) (setq mehrdeutig (cons top mehrdeutig))))))
|
||||
(list (reverse racks)
|
||||
(length (vl-remove-if '(lambda (m) (member m racks)) mehrdeutig)))
|
||||
)
|
||||
|
||||
;; Racks der Quelle ohne Lager-Layer auf den Regal-Layer der Quelle legen -
|
||||
;; nach der Kopie liegen sie deckungsgleich mit den Kopien, nur der Layer
|
||||
;; trennt sie dann (Export, LG_GESCHOSS_AKTIV). Rueckgabe: Anzahl.
|
||||
(defun lg-racks-umhaengen (racks src / lay n)
|
||||
(setq n 0)
|
||||
(foreach r racks
|
||||
(if (null (lg-geschoss-aus-layer (lg-ent-layer r)))
|
||||
(progn
|
||||
(if (null lay) (setq lay (lg-layer "goh_rack" src)))
|
||||
(vla-put-Layer (vlax-ename->vla-object r) lay)
|
||||
(setq n (1+ n)))))
|
||||
n
|
||||
)
|
||||
|
||||
;; Racks per vla-Copy (MCAD-Parameter bleiben) um v versetzt ins Geschoss
|
||||
;; nr kopieren. Rueckgabe: Anzahl.
|
||||
(defun lg-racks-kopieren (racks nr v / lay n res)
|
||||
(setq n 0 lay (if racks (lg-layer "goh_rack" nr)))
|
||||
(foreach r racks
|
||||
(setq res (vl-catch-all-apply
|
||||
'(lambda ( / obj)
|
||||
(setq obj (vla-Copy (vlax-ename->vla-object r)))
|
||||
(vla-Move obj (vlax-3d-point '(0.0 0.0 0.0)) (vlax-3d-point v))
|
||||
(vla-put-Layer obj lay)
|
||||
T)))
|
||||
(if (vl-catch-all-error-p res)
|
||||
(princ (ssg-textf "lg-einfuegen-fehler" (list (lg-blockname r) (vl-catch-all-error-message res))))
|
||||
(setq n (1+ n))))
|
||||
n
|
||||
)
|
||||
|
||||
;; Eine Kopie des Geschosses src-nr als Geschoss nr auf hoehe, um v versetzt.
|
||||
;; Rueckgabe: (geschoss-ent reihen gaenge racks) oder nil.
|
||||
(defun lg-geschoss-kopieren (src-nr nr hoehe belag-neu v racks
|
||||
;; Rueckgabe: (geschoss-ent reihen gaenge) oder nil.
|
||||
(defun lg-geschoss-kopieren (src-nr nr hoehe belag-neu v
|
||||
/ src a belag-alt k werte blk zuordnung kk nb ab ed p1 p2 rot
|
||||
laenge nb-h art n-reihen n-gaenge s-gs)
|
||||
(setq src (lg-geschoss-finden src-nr)
|
||||
@@ -1961,8 +1632,7 @@
|
||||
belag-alt belag-neu)
|
||||
nb)
|
||||
(if (= art "reihe") (setq n-reihen (1+ n-reihen)) (setq n-gaenge (1+ n-gaenge)))))))
|
||||
;; 4. goh_rack
|
||||
(list blk n-reihen n-gaenge (lg-racks-kopieren racks nr v))))
|
||||
(list blk n-reihen n-gaenge)))
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -1971,7 +1641,7 @@
|
||||
;; VERSATZ_X_mm VERSATZ_Y_mm), nicht interaktiv - auch fuer Tests.
|
||||
;; Rueckgabe: Liste der neuen Geschossnummern oder nil.
|
||||
(defun lg-geschosse-kopieren (werte / src-nr src n abstand belag dx dy kandidaten
|
||||
rq racks nr erg neu)
|
||||
nr erg neu)
|
||||
(setq src-nr (atoi (cond ((cdr (assoc "QUELLE" werte))) ("0")))
|
||||
src (lg-geschoss-finden src-nr)
|
||||
n (atoi (cond ((cdr (assoc "ANZAHL" werte))) ("1")))
|
||||
@@ -1985,23 +1655,17 @@
|
||||
((< n 1) nil)
|
||||
(T
|
||||
(setq kandidaten (lg-geschoss-kandidaten))
|
||||
;; Racks VOR der ersten Kopie bestimmen (danach waere die Kontur mehrdeutig)
|
||||
(setq rq (lg-racks-der-quelle src-nr kandidaten)
|
||||
racks (car rq))
|
||||
(if (> (cadr rq) 0) (princ (ssg-textf "lg-kopie-racks-mehrdeutig" (list (itoa (cadr rq))))))
|
||||
(if (> (setq neu (lg-racks-umhaengen racks src-nr)) 0)
|
||||
(princ (ssg-textf "lg-kopie-racks-umgehaengt" (list (itoa neu) (itoa src-nr)))))
|
||||
(setq erg nil)
|
||||
(foreach p (lg-kopie-plan (lg-geschoss-hoehe src) abstand n dx dy (lg-kopie-3d-p kandidaten))
|
||||
(if (vl-some '(lambda (k) (equal (cadr k) (cadr p) 1.0)) (lg-geschoss-kandidaten))
|
||||
(princ (ssg-textf "lg-kopie-hoehe-belegt" (list (lg-mm-str (cadr p))))))
|
||||
(setq nr (lg-geschoss-naechste-nr))
|
||||
(if (setq neu (lg-geschoss-kopieren src-nr nr (cadr p) belag (caddr p) racks))
|
||||
(if (setq neu (lg-geschoss-kopieren src-nr nr (cadr p) belag (caddr p)))
|
||||
(progn
|
||||
(setq erg (cons nr erg))
|
||||
(princ (ssg-textf "lg-kopie-fertig"
|
||||
(list (itoa src-nr) (itoa nr) (lg-mm-str (cadr p))
|
||||
(itoa (cadr neu)) (itoa (caddr neu)) (itoa (cadddr neu))))))))
|
||||
(itoa (cadr neu)) (itoa (caddr neu))))))))
|
||||
(if erg
|
||||
(progn
|
||||
(lg-ldata-setzen "GESCHOSS_AKTIV" (car erg))
|
||||
@@ -2061,7 +1725,7 @@
|
||||
(entmod (subst (cons 70 f) (assoc 70 ed) ed))))
|
||||
)
|
||||
|
||||
;; Geschoss mit Belag, Bereichen, Reihen, Gaengen und goh_racks in ein oder
|
||||
;; Geschoss mit Belag, Bereichen, Reihen und Gaengen in ein oder
|
||||
;; mehrere neue Geschosse kopieren (siehe lg-geschosse-kopieren).
|
||||
(defun c:LG_GESCHOSS_KOPIEREN ( / werte)
|
||||
(ssg-start (ssg-text "lg-titel-kopie") nil)
|
||||
@@ -2472,41 +2136,9 @@
|
||||
(cons "handle" (lg-handle e)))))
|
||||
)
|
||||
|
||||
;; goh_rack-Bloecke sammeln (lg-racks-sammeln). Geschoss ueber den Layer
|
||||
;; des obersten INSERTs (_G<nr>), sonst ueber die Kontur (lg-rack-geschoss).
|
||||
;; Rueckgabe: (json-texte warnungen)
|
||||
(defun lg-export-goh-racks (kandidaten / texte warn gs ebenen vorgabe)
|
||||
(setq texte nil warn nil
|
||||
vorgabe (lg-vorgabe '("reihe" "haengeebenen") "2300/1200;1100/1100"))
|
||||
(foreach r (lg-racks-sammeln)
|
||||
(setq gs (lg-rack-geschoss (lg-ent-layer (lg-rk-top r)) (lg-rk-mitte r) kandidaten))
|
||||
(if (and (null gs) kandidaten)
|
||||
(setq warn (cons (ssg-textf "lg-exp-rack-ohne-geschoss"
|
||||
(list (rtos (car (lg-rk-mitte r)) 2 0) (rtos (cadr (lg-rk-mitte r)) 2 0)))
|
||||
warn)))
|
||||
(setq ebenen (if (lg-rk-ebenen r) (fix (lg-rk-ebenen r))))
|
||||
(if (null (lg-rk-laenge r))
|
||||
(setq warn (cons (ssg-textf "lg-exp-rack-ohne-laenge" (list (lg-rk-name r))) warn)))
|
||||
(setq texte (cons
|
||||
(lg-json-obj
|
||||
(list (cons "geschoss" gs)
|
||||
(cons "name" (lg-rk-name r))
|
||||
(cons "laenge_mm" (lg-rk-laenge r))
|
||||
(cons "ebenen" ebenen)
|
||||
(cons "tiefe_mm" (lg-zahl (lg-vorgabe '("goh_rack" "tiefe_mm") 700)))
|
||||
(cons "haengeebenen" (lg-json-ebenen (if ebenen (lg-haengeebenen-n vorgabe ebenen) vorgabe)))
|
||||
(cons "haengeebenen_quelle" "vorgabe")
|
||||
(cons "position" (lg-json-zahlen (lg-rk-mitte r)))))
|
||||
texte)))
|
||||
(list (reverse texte) (reverse warn))
|
||||
)
|
||||
|
||||
;; Alle Daten als JSON-Text.
|
||||
(defun lg-export-json ( / gs kandidaten racks warn gs-ohne)
|
||||
(setq gs (lg-geschosse)
|
||||
kandidaten (lg-geschoss-kandidaten)
|
||||
racks (lg-export-goh-racks kandidaten)
|
||||
warn (cadr racks))
|
||||
(defun lg-export-json ( / gs warn)
|
||||
(setq gs (lg-geschosse) warn nil)
|
||||
(if (null gs) (setq warn (cons (ssg-text "lg-exp-keine-geschosse") warn)))
|
||||
(foreach g gs
|
||||
(if (null (cadddr g))
|
||||
@@ -2526,7 +2158,6 @@
|
||||
" \"bereiche\": " (lg-json-arr (mapcar 'lg-export-bereich (lg-alle-bloecke "LG_BEREICH")) " ") ",\n"
|
||||
" \"reihen\": " (lg-json-arr (mapcar '(lambda (e) (lg-export-linie e "reihe")) (lg-alle-bloecke "LG_REIHE_*")) " ") ",\n"
|
||||
" \"gaenge\": " (lg-json-arr (mapcar '(lambda (e) (lg-export-linie e "gang")) (lg-alle-bloecke "LG_GANG_*")) " ") ",\n"
|
||||
" \"goh_racks\": " (lg-json-arr (car racks) " ") ",\n"
|
||||
" \"warnungen\": " (lg-json-arr (mapcar 'lg-json-wert warn) " ") "\n"
|
||||
"}\n")
|
||||
)
|
||||
|
||||
Reference in new issue
Block a user