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

:wqerge branch 'master' of https://gitea.schoenenberger.de/m.stangl/dxfmakros

Browse Source
This commit is contained in:
Yuelin Wang
2026-05-28 14:45:39 +02:00
parent 3b3cc2a005 788593599a
commit 2400c20e37
6 changed files with 566 additions and 206 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Lisp/KreiselInsert.lsp
+307 -158
View File
@@ -8,10 +8,13 @@
;; TEIL 1: GLOBALE EINSTELLUNGEN
;; ============================================================
;; Zähler für Kreisel-Nummerierung (wird in Zeichnung gespeichert)
;; Zähler für Nummerierung (werden in Zeichnung gespeichert)
(if (null #Kreisel_LetzteNr)
(setq #Kreisel_LetzteNr 0)
)
(if (null #Eckrad_LetzteNr)
(setq #Eckrad_LetzteNr 0)
)
;; Block-Pfad
(setq block-pfad (getenv "DXFM_BLOCKS"))
@@ -47,6 +50,18 @@
("HOEHE" "0"))
)
;; Eckrad-Einstellungen
(setq *eckrad-default-hoehe* 2000.0) ;; Standard-Höhe (Z-Koordinate)
;; Eckrad Attribut-Definitionen: ((TAG DEFAULT) ...)
(setq *eckrad-attrib-defs*
'(("NAME" "")
("DREHRICHTUNG" "UZS")
("DREHUNG" "0")
("NUMMER" "0")
("HOEHE" "0"))
)
;; Letzter gewaehlter Typ (gespeichert zwischen Aufrufen)
(if (null #Kreisel_Typ) (setq #Kreisel_Typ "STANDARD"))
@@ -80,11 +95,20 @@
style-name
)
;; Nächste freie Kreisel-Nummer ermitteln
(defun kreisel-next-number ( / maxNr tag val ss i ent attribs)
;; Allgemeine Nummerierung: Naechste freie Nummer fuer einen Komponententyp ermitteln
;; blockprefix = Blockname-Praefix fuer ssget (z.B. "KREISEL_*" oder "ECKRAD_*")
;; lastNrVar = Symbol der globalen Zaehler-Variable (z.B. '#Kreisel_LetzteNr)
;; Rueckgabe: naechste freie Nummer (integer)
(defun component-next-number (blockprefix lastNrVar / maxNr tag val ss i ent attribs lastNr result)
(dbgf "component-next-number")
(dbg 'blockprefix)
(dbg 'lastNrVar)
(setq maxNr 0)
(if (setq ss (ssget "_X" '((0 . "INSERT") (2 . "KREISEL_*"))))
(setq lastNr (eval lastNrVar))
(dbgp (strcat "lastNr=" (itoa lastNr)))
(if (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 blockprefix))))
(progn
(dbgp (strcat "Gefundene Bloecke: " (itoa (sslength ss))))
(setq i 0)
(repeat (sslength ss)
(setq ent (ssname ss i))
@@ -96,12 +120,32 @@
(setq i (1+ i))
)
)
(dbgp "Keine bestehenden Bloecke gefunden")
)
(if (= maxNr 0)
(setq maxNr #Kreisel_LetzteNr)
(setq maxNr lastNr)
)
(setq #Kreisel_LetzteNr (1+ maxNr))
#Kreisel_LetzteNr
(set lastNrVar (1+ maxNr))
(setq result (eval lastNrVar))
(dbgp (strcat "Naechste Nummer: " (itoa result)))
(dbgreturn result)
result
)
;; Wrapper: Naechste Kreisel-Nummer
(defun kreisel-next-number ( / result)
(dbgf "kreisel-next-number")
(setq result (component-next-number "KREISEL_*" '#Kreisel_LetzteNr))
(dbgreturn result)
result
)
;; Wrapper: Naechste Eckrad-Nummer
(defun eckrad-next-number ( / result)
(dbgf "eckrad-next-number")
(setq result (component-next-number "ECKRAD_*" '#Eckrad_LetzteNr))
(dbgreturn result)
result
)
;; Beschriftungstext erzeugen
@@ -295,7 +339,22 @@
;; WICHTIG: Vor dem Zeichnen den aktuellen letzten Entity merken
;; Aber wenn die Zeichnung leer ist, setzen wir lastEnt auf nil
(if (setq lastEnt (entlast))
(princ) ;; Letzte Entity existiert
(progn
;; Falls lastEnt ein INSERT mit Attributen ist, muessen wir
;; bis zum SEQEND navigieren, da entnext sonst in die
;; ATTRIB-Sub-Entities hineinlaeuft
(if (and (= (cdr (assoc 0 (entget lastEnt))) "INSERT")
(= (cdr (assoc 66 (entget lastEnt))) 1))
(progn
(setq lastEnt (entnext lastEnt))
(while (and lastEnt
(/= (cdr (assoc 0 (entget lastEnt))) "SEQEND"))
(setq lastEnt (entnext lastEnt))
)
;; lastEnt ist jetzt SEQEND - entnext darauf gibt das naechste Top-Level-Entity
)
)
)
(setq lastEnt nil) ;; Zeichnung ist leer
)
@@ -491,159 +550,78 @@
;; -----------------------------------------------
;; KreiselConnect: 2 parallele Linien anklicken
;; KreiselConnect: Linie zeichnen fuer Kreisel-Platzierung
;;
;; Ablauf:
;; 1. Erste Linie anklicken -> AN-Position (Antriebsstation)
;; 2. Zweite Linie anklicken -> SP-Seite (Spannstation)
;; 3. Richtung + Abstand werden aus der Geometrie berechnet
;; 4. Nur Kreiselart (PIN/STANDARD) wird abgefragt
;;
;; Beide Linien muessen parallel sein und gleiche Z-Koordinate haben.
;; Horizontale und vertikale Linien werden unterstuetzt.
;; 1. Startpunkt anklicken -> aeusserster AN-Punkt (Antriebsstation)
;; 2. Endpunkt anklicken -> aeusserster SP-Punkt (Spannstation)
;; 3. Abstand = Distanz - Durchmesser, Rotation aus Winkel
;; 4. Hoehe aus Z-Koordinate des Startpunkts
;; 5. Nur Kreiselart (PIN/STANDARD) wird abgefragt
;; -----------------------------------------------
(defun c:KreiselConnect ( / sel1 ent1 pt1 sel2 ent2 pt2
lpts1 lpts2 s1 e1 s2 e2
dir1 dir2 snap1 foot
dx dy dist abstand rotation typ hoehe
z1s z1e z2s z2e zCoord zTol
ok msg)
(defun c:KreiselConnect ( / ptStart ptEnd dx dy dist abstand rotation typ hoehe)
(ssg-start "Kreisel Smart Connect" '(("OSMODE") ("CECOLOR")))
(setq ok T msg nil)
(princ "\n--- Kreisel zwischen zwei parallelen Linien ---")
(princ "\n--- Kreisel durch Linie definieren (AN -> SP) ---")
;; 1. Erste Linie anklicken (AN-Seite)
(if ok
;; 1. Startpunkt (aeusserster Punkt AN-Seite)
(setq ptStart (getpoint "\nStartpunkt (AN-Seite aussen): "))
(if (null ptStart)
(progn (ssg-end) (princ "\nAbgebrochen.") (princ) (exit))
)
;; 2. Endpunkt (aeusserster Punkt SP-Seite) mit Gummiband
(setq ptEnd (getpoint ptStart "\nEndpunkt (SP-Seite aussen): "))
(if (null ptEnd)
(progn (ssg-end) (princ "\nAbgebrochen.") (princ) (exit))
)
;; 3. Geometrie berechnen
(setq dx (- (car ptEnd) (car ptStart))
dy (- (cadr ptEnd) (cadr ptStart)))
(setq dist (sqrt (+ (* dx dx) (* dy dy))))
(setq abstand (- dist *kreisel-durchmesser*))
(if (<= abstand 0.0)
(progn
(setq sel1 (entsel "\nErste Linie anklicken (AN-Seite): "))
(cond
((null sel1)
(setq ok nil))
((/= (cdr (assoc 0 (entget (car sel1)))) "LINE")
(setq ok nil msg "Erste Auswahl ist kein LINE-Objekt!"))
)
(ssg-emsg (strcat "Distanz zu klein! ("
(rtos dist 2 0) " < " (rtos *kreisel-durchmesser* 2 0) ")"))
(ssg-end)
(exit)
)
)
;; 2. Zweite Linie anklicken (SP-Seite)
(if ok
;; 4. Rotation aus Winkel Start->End
(setq rotation (* (/ 180.0 pi) (atan dy dx)))
;; 5. Hoehe aus Z-Koordinate des Startpunkts
(if (and (> (length ptStart) 2) (caddr ptStart))
(setq hoehe (caddr ptStart))
(setq hoehe 0.0)
)
(if (<= hoehe 0.0)
(progn
(setq sel2 (entsel "\nZweite Linie anklicken (SP-Seite): "))
(cond
((null sel2)
(setq ok nil))
((/= (cdr (assoc 0 (entget (car sel2)))) "LINE")
(setq ok nil msg "Zweite Auswahl ist kein LINE-Objekt!"))
)
(setq hoehe (getreal (strcat "\nHoehe (Z-Koordinate) <" (rtos *kreisel-default-hoehe* 2 0) ">: ")))
(if (null hoehe) (setq hoehe *kreisel-default-hoehe*))
)
(princ (strcat "\n-> Hoehe aus Startpunkt uebernommen: " (rtos hoehe 2 0)))
)
;; 3. Geometrie auswerten
(if ok
(progn
(setq ent1 (car sel1) pt1 (cadr sel1))
(setq ent2 (car sel2) pt2 (cadr sel2))
;; 6. Kreiselart abfragen
(setq typ (kreisel-ask-typ))
;; Linien-Endpunkte lesen
(setq lpts1 (kreisel-get-line-pts ent1)
s1 (car lpts1) e1 (cadr lpts1))
(setq lpts2 (kreisel-get-line-pts ent2)
s2 (car lpts2) e2 (cadr lpts2))
(princ (strcat "\n-> Abstand: " (rtos abstand 2 0) " mm"
" Rotation: " (rtos rotation 2 1) " Grad"
" Hoehe: " (rtos hoehe 2 0)
" Kreiselart: " typ))
;; Richtungsvektoren
(setq dir1 (list (- (car e1) (car s1)) (- (cadr e1) (cadr s1))))
(setq dir2 (list (- (car e2) (car s2)) (- (cadr e2) (cadr s2))))
;; Parallelitaet pruefen
(if (not (kreisel-parallel-p dir1 dir2))
(setq ok nil msg "Linien sind nicht parallel!")
)
;; Z-Koordinaten pruefen (alle 4 Endpunkte muessen gleiche Hoehe haben)
(if ok
(progn
(setq z1s (caddr s1) z1e (caddr e1)
z2s (caddr s2) z2e (caddr e2))
;; Fehlende Z-Werte als 0 behandeln
(if (null z1s) (setq z1s 0.0))
(if (null z1e) (setq z1e 0.0))
(if (null z2s) (setq z2s 0.0))
(if (null z2e) (setq z2e 0.0))
(setq zTol 0.1)
(if (or (> (abs (- z1s z1e)) zTol)
(> (abs (- z2s z2e)) zTol)
(> (abs (- z1s z2s)) zTol))
(setq ok nil msg "Start und Ziel auf ungleicher Hoehe!")
(setq zCoord z1s)
)
)
)
)
)
;; 4. Positionen und Abstand berechnen
(if ok
(progn
;; Klickpunkt exakt auf Linie 1 projizieren
(setq snap1 (kreisel-project-point (list (car pt1) (cadr pt1)) s1 e1))
;; Von snap1 senkrecht auf Linie 2 projizieren
(setq foot (kreisel-project-point snap1 s2 e2))
;; Richtung und Distanz
(setq dx (- (car foot) (car snap1))
dy (- (cadr foot) (cadr snap1)))
(setq dist (sqrt (+ (* dx dx) (* dy dy))))
(setq abstand (- dist *kreisel-durchmesser*))
(if (<= abstand 0.0)
(setq ok nil
msg (strcat "Abstand zwischen Linien zu klein! ("
(rtos dist 2 0) " < " (rtos *kreisel-durchmesser* 2 0) ")"))
)
)
)
;; 5. Rotation berechnen und Modul einfuegen
(if ok
(progn
;; Winkel von AN-Punkt (snap1) zum SP-Fusspunkt (foot)
(setq rotation (* (/ 180.0 pi) (atan dy dx)))
;; Höhe (Z-Koordinate) - NUR abfragen, wenn zCoord keine Höhe hat (also 0 ist)
(if (and zCoord (> zCoord 0))
(progn
(setq hoehe zCoord)
(princ (strcat "\n-> Höhe aus Linie übernommen: " (rtos hoehe 2 0)))
)
(progn
(setq hoehe (getreal (strcat "\nHöhe (Z-Koordinate) <" (rtos *kreisel-default-hoehe* 2 0) ">: ")))
(if (null hoehe) (setq hoehe *kreisel-default-hoehe*))
)
)
;; Kreiselart abfragen (einzige Benutzer-Eingabe)
(setq typ (kreisel-ask-typ))
(princ (strcat "\n-> Abstand: " (rtos abstand 2 0) " mm"
" Rotation: " (rtos rotation 2 1) " Grad"
" Höhe: " (rtos hoehe 2 0)
" Kreiselart: " typ))
;; Modul als Compound-Block einfuegen (mit Z-Koordinate)
;; NEU - Höhe im Aufruf übergeben:
(draw-module (list (car snap1) (cadr snap1) hoehe) abstand rotation
(list (cons "KREISELART" typ)
(cons "HOEHE" (rtos hoehe 2 0)))) ;; <-- HOEHE Attribut
(princ "\nKreisel Connect erfolgreich!")
)
;; Fehlerfall
(if msg (ssg-emsg msg) (princ "\nAbgebrochen."))
)
;; 7. Modul einfuegen
(draw-module (list (car ptStart) (cadr ptStart) hoehe) abstand rotation
(list (cons "KREISELART" typ)
(cons "HOEHE" (rtos hoehe 2 0))))
(princ "\nKreisel Connect erfolgreich!")
(ssg-end)
)
@@ -955,20 +933,15 @@
;; --------------------------------------------
;; ILS_Eckrad: Einzelnen AN8-Block einfuegen
;;
;; Fuegt den Block AN8.dwg an einem gewaehlten Punkt
;; mit waehlbarer Rotation ein (Eckrad / Umlenkrad).
;; ILS_Eckrad: Befehl - fragt Eingaben ab und fuegt Eckrad ein
;; --------------------------------------------
(defun c:ILS_Eckrad ( / pt rotStr rotation)
(ssg-start "Eckrad einfuegen" '(("ATTREQ") ("ATTDIA")))
(setvar "ATTREQ" 0)
(setvar "ATTDIA" 0)
(defun c:ILS_Eckrad ( / pt rotStr rotation hoehe)
(dbgf "c:ILS_Eckrad")
;; 1. Einfuegepunkt
(setq pt (getpoint "\nEinfuegepunkt Eckrad: "))
(if (null pt) (progn (ssg-end) (exit)))
(if (null pt) (progn (dbgreturn nil) (exit)))
(dbg 'pt)
;; 2. Rotation
(setq rotStr (getstring "\nRotation in Grad <0>: "))
@@ -976,14 +949,190 @@
(setq rotation 0.0)
(setq rotation (atof rotStr))
)
(dbg 'rotation)
;; 3. AN8 einfuegen
(command "_.INSERT" (strcat *block-path* "AN8.dwg") pt 1 1 rotation)
;; 3. Hoehe bestimmen
(if (and (> (length pt) 2) (caddr pt) (> (caddr pt) 0))
(progn
(setq hoehe (caddr pt))
(princ (strcat "\n-> Hoehe aus 3D-Punkt uebernommen: " (rtos hoehe 2 0)))
)
(progn
(setq hoehe (getreal (strcat "\nHoehe (Z-Koordinate) <" (rtos *eckrad-default-hoehe* 2 0) ">: ")))
(if (null hoehe) (setq hoehe *eckrad-default-hoehe*))
)
)
(dbg 'hoehe)
(princ (strcat "\nEckrad eingefuegt bei "
(rtos (car pt) 2 1) "," (rtos (cadr pt) 2 1)
" Rotation=" (rtos rotation 2 1)))
;; 4. Einfuegen
(ils-eckrad-insert (list (car pt) (cadr pt) hoehe) rotation nil)
(dbgreturn nil)
)
;; --------------------------------------------
;; ils-eckrad-insert: Erzeugt Eckrad als Compound-Block mit Attributen
;; Parameter:
;; pt - Einfuegepunkt (Liste x y z)
;; rotation - Drehwinkel in Grad
;; attribs - alist mit Attribut-Ueberschreibungen (nil = Defaults)
;; Rueckgabe: Entity-Name des eingefuegten Blocks
;; --------------------------------------------
(defun ils-eckrad-insert (pt rotation attribs / lastEnt ss e bname
eckrad-nummer block-exists
z-hoehe block-hoehe
insertPoint block-ent
att-entity att-data att-tag new-value)
(dbgf "ils-eckrad-insert")
(dbg 'pt)
(dbg 'rotation)
(ssg-start "Eckrad einfuegen" '(("ATTREQ") ("ATTDIA") ("OSMODE") ("CECOLOR")))
;; Attribute vorbereiten
(setq attribs (ssg-attrib-merge attribs *eckrad-attrib-defs*))
(setq attribs (subst (cons "DREHUNG" (rtos rotation 2 1))
(assoc "DREHUNG" attribs) attribs))
(dbgp "Attribute nach merge vorbereitet")
;; Hoehe bestimmen
(if (and pt (caddr pt) (> (caddr pt) 0))
(progn
(setq z-hoehe (caddr pt))
(setq block-hoehe (rtos z-hoehe 2 0))
)
(progn
(setq block-hoehe (cdr (assoc "HOEHE" attribs)))
(if (or (null block-hoehe) (= block-hoehe ""))
(setq block-hoehe "0")
)
(setq z-hoehe (atof block-hoehe))
)
)
(setq attribs (subst (cons "HOEHE" block-hoehe)
(assoc "HOEHE" attribs) attribs))
(dbg 'z-hoehe)
(dbg 'block-hoehe)
;; Automatische Nummer vergeben
(setq eckrad-nummer (eckrad-next-number))
(setq attribs (subst (cons "NUMMER" (itoa eckrad-nummer))
(assoc "NUMMER" attribs) attribs))
(dbg 'eckrad-nummer)
;; Blockname: ECKRAD_1, ECKRAD_2, ...
(setq bname (strcat "ECKRAD_" (itoa eckrad-nummer)))
(dbg 'bname)
;; Pruefen ob Block bereits existiert
(setq block-exists (tblsearch "BLOCK" bname))
(dbgp (strcat "block-exists=" (if block-exists "JA" "NEIN")))
;; ATTREQ/ATTDIA und OSMODE setzen
(setvar "ATTREQ" 0)
(setvar "ATTDIA" 0)
(setvar "OSMODE" 0)
;; --- Geometrie NUR zeichnen, wenn Block noch nicht existiert ---
(if (not block-exists)
(progn
(dbgp "Erzeuge neue Blockdefinition...")
;; Letzten Entity merken (mit SEQEND-Schutz wie bei draw-module)
(if (setq lastEnt (entlast))
(progn
(dbgp (strcat "lastEnt Typ=" (cdr (assoc 0 (entget lastEnt)))))
(if (and (= (cdr (assoc 0 (entget lastEnt))) "INSERT")
(= (cdr (assoc 66 (entget lastEnt))) 1))
(progn
(dbgp "lastEnt ist INSERT mit Attributen -> navigiere zu SEQEND")
(setq lastEnt (entnext lastEnt))
(while (and lastEnt
(/= (cdr (assoc 0 (entget lastEnt))) "SEQEND"))
(setq lastEnt (entnext lastEnt))
)
(dbgp "SEQEND erreicht")
)
)
)
(setq lastEnt nil)
)
;; AN8 Block einfuegen bei (0,0) - Eckrad ist ein einzelner Kreis
(dbgp (strcat "INSERT Block: " *block-path* "AN8.dwg"))
(command "_.INSERT" (strcat *block-path* "AN8.dwg") (list 0.0 0.0 0.0) 1 1 0)
;; Unsichtbare Attribut-Definitionen erzeugen
(dbgp (strcat "Erzeuge " (itoa (length *eckrad-attrib-defs*)) " Attribut-Definitionen"))
(ssg-attrib-make-defs *eckrad-attrib-defs* 50.0)
;; Neue Entities einsammeln
(setq ss (ssadd))
(if (null lastEnt)
(setq e (entnext))
(setq e (entnext lastEnt))
)
(while e
(ssadd e ss)
(setq e (entnext e))
)
(dbgp (strcat "Entities eingesammelt: " (itoa (sslength ss))))
;; Block erzeugen
(if (> (sslength ss) 0)
(progn
(command "_.-BLOCK" bname (list 0.0 0.0 0.0) ss "")
(dbgp (strcat "Blockdefinition erzeugt: " bname))
)
(progn
(princ "\nFehler: Keine Entities zum Block erstellen!")
(dbgp "FEHLER: Keine Entities fuer Block!")
)
)
(princ (strcat "\n-> Neue Blockdefinition: " bname))
)
(progn
(princ (strcat "\n-> Verwende bestehende Blockdefinition: " bname))
(dbgp (strcat "Verwende bestehende Blockdefinition: " bname))
)
)
;; Block am Zielpunkt einfuegen
(setq insertPoint (list (car pt) (cadr pt) z-hoehe))
(dbg 'insertPoint)
(dbgp (strcat "INSERT " bname " bei " (rtos (car insertPoint) 2 1)
"," (rtos (cadr insertPoint) 2 1)
"," (rtos (caddr insertPoint) 2 1)
" Rotation=" (rtos rotation 2 1)))
(command "_.INSERT" bname insertPoint 1 1 rotation)
;; Attribut-Werte durch direkte Datenbankaenderung setzen
(setq block-ent (entlast))
(setq att-entity (entnext block-ent))
(dbgp "Setze Attribut-Werte:")
(while att-entity
(setq att-data (entget att-entity))
(if (= (cdr (assoc 0 att-data)) "ATTRIB")
(progn
(setq att-tag (cdr (assoc 2 att-data)))
(setq new-value (cdr (assoc att-tag attribs)))
(if new-value
(progn
(dbgp (strcat " " att-tag "=" new-value))
(setq att-data (subst (cons 1 new-value) (assoc 1 att-data) att-data))
(entmod att-data)
)
)
)
)
(setq att-entity (entnext att-entity))
)
(entupd block-ent)
(princ (strcat "\n-> Eckrad #" (itoa eckrad-nummer) " eingefuegt: " bname
" bei " (rtos (car pt) 2 1) "," (rtos (cadr pt) 2 1)
" Rotation=" (rtos rotation 2 1)
" Hoehe=" block-hoehe))
(ssg-end)
(dbgreturn (entlast))
)
;; NEU: KreiselLabelSetup - Hier einfügen!
Lisp/ssg_dbg.lsp
+77 -46
View File
@@ -12,31 +12,27 @@
;; (dbgp "text") - Debug-Print (Alias fuer dbgmsg)
;; (dbgmsg "text") - Freitext-Nachricht loggen
;;
;; Strategie: dbgf/dbg/dbgmsg puffern im Speicher.
;; dbgreturn flusht den Puffer auf die Platte (open/append/close).
;; So hat jede Funktion mindestens einen Schreibvorgang,
;; ohne dass jeder einzelne dbg-Aufruf die Datei oeffnet.
;;
;; dbgon/dbgoff steuert, ob Ausgaben geschrieben werden.
;; Damit kann man gezielt nur bestimmte Abschnitte debuggen.
;; Ein (dbgoff) VOR (dbgopen) verhindert das Anlegen der Datei.
;;
;; Beispiel:
;; (dbgopen "test.dbg")
;; (dbgoff) ; ab hier keine Ausgabe
;; (dbgf "unwichtig") ; wird NICHT geschrieben
;; (dbgreturn 0)
;; (dbgon) ; ab hier wieder Ausgabe
;; (dbgopen "test.dbg" "DXFM_LOG")
;; (dbgf "meine-funktion")
;; (dbg 'x)
;; (dbgreturn ergebnis)
;; (dbgreturn ergebnis) ; <-- hier wird alles geschrieben
;; (dbgclose)
;;
;; Erzeugt z.B.:
;; meine-funktion(){
;; x=42
;; } = 99
;; ============================================================
;; Globale Variablen
(setq *dbg-file* nil) ; Datei-Handle
(setq *dbg-path* nil) ; Voller Dateipfad (String)
(setq *dbg-indent* 0) ; Aktuelle Einruecktiefe
(setq *dbg-active* T) ; Debug-Ausgabe aktiv (Standard: ein)
(setq *dbg-buffer* nil) ; Zeilenpuffer (Liste von Strings)
;; ------------------------------------------------------------
;; DBGON - Debug-Ausgabe aktivieren
@@ -54,6 +50,33 @@
(princ)
)
;; ------------------------------------------------------------
;; DBG-FLUSH - Puffer auf Platte schreiben (open/append/close)
;; ------------------------------------------------------------
(defun dbg-flush (/ fh)
(if (and *dbg-path* *dbg-buffer*)
(progn
(setq fh (open *dbg-path* "a"))
(if fh
(progn
(foreach line (reverse *dbg-buffer*)
(write-line line fh)
)
(close fh)
)
)
(setq *dbg-buffer* nil)
)
)
)
;; ------------------------------------------------------------
;; DBG-BUFWRITE - Zeile in den Puffer schreiben
;; ------------------------------------------------------------
(defun dbg-bufwrite (line)
(setq *dbg-buffer* (cons line *dbg-buffer*))
)
;; ------------------------------------------------------------
;; DBGOPEN - Debug-Datei oeffnen
;; Wenn *dbg-active* nil ist, wird keine Datei angelegt.
@@ -62,12 +85,8 @@
;; envvar - Optional: Name einer Umgebungsvariable fuer das
;; Zielverzeichnis (z.B. "DXFM_LOG").
;; Wenn nil oder nicht gesetzt, wird "." verwendet.
;; Aufruf:
;; (dbgopen "test.dbg" "DXFM_LOG") -> C:\...\log\test.dbg
;; (dbgopen "test.dbg" nil) -> .\test.dbg
;; (dbgopen "test.dbg") -> .\test.dbg
;; ------------------------------------------------------------
(defun dbgopen (filename envvar / dir fullpath ts)
(defun dbgopen (filename envvar / dir fullpath fh ts)
(if (not *dbg-active*)
(progn
(prompt "\n[DBG] Debug deaktiviert - keine Datei angelegt.")
@@ -85,22 +104,31 @@
(if (or (not dir) (= dir ""))
(setq dir ".")
)
;; Pfad zusammenbauen (Backslash am Ende sicherstellen)
;; Backslash am Ende sicherstellen
(if (and (/= (substr dir (strlen dir) 1) "\\")
(/= (substr dir (strlen dir) 1) "/"))
(setq dir (strcat dir "\\"))
)
;; Verzeichnis anlegen falls es nicht existiert
(if (not (vl-file-directory-p (vl-string-right-trim "\\/" dir)))
(progn
(vl-mkdir (vl-string-right-trim "\\/" dir))
(prompt (strcat "\n[DBG] Verzeichnis angelegt: " dir))
)
)
(setq fullpath (strcat dir filename))
(prompt (strcat "\n[DBG] Oeffne: " fullpath))
(if *dbg-file* (close *dbg-file*))
(setq *dbg-file* (open fullpath "w"))
(setq *dbg-indent* 0)
(if *dbg-file*
;; Datei mit "w" erstellen/leeren, Header schreiben, sofort schliessen
(setq fh (open fullpath "w"))
(if fh
(progn
;; Timestamp sicher erzeugen (menucmd kann nil liefern)
(setq *dbg-path* fullpath)
(setq *dbg-indent* 0)
(setq *dbg-buffer* nil)
(setq ts (menucmd "M=$(edtime,$(getvar,date),YYYY-MO-DD HH:MM:SS)"))
(if (not ts) (setq ts "(kein Zeitstempel)"))
(write-line (strcat "=== DEBUG START " ts " ===") *dbg-file*)
(write-line (strcat "=== DEBUG START " ts " ===") fh)
(close fh)
(prompt (strcat "\n[DBG] Debug-Datei geoeffnet: " fullpath))
)
(prompt (strcat "\n[DBG] FEHLER: Konnte Debug-Datei nicht oeffnen: " fullpath))
@@ -111,16 +139,16 @@
)
;; ------------------------------------------------------------
;; DBGCLOSE - Debug-Datei schliessen
;; DBGCLOSE - Debug-Datei schliessen (Puffer + Abschluss schreiben)
;; ------------------------------------------------------------
(defun dbgclose ( / ts)
(if *dbg-file*
(if *dbg-path*
(progn
(setq ts (menucmd "M=$(edtime,$(getvar,date),YYYY-MO-DD HH:MM:SS)"))
(if (not ts) (setq ts "(kein Zeitstempel)"))
(write-line (strcat "=== DEBUG ENDE " ts " ===") *dbg-file*)
(close *dbg-file*)
(setq *dbg-file* nil)
(dbg-bufwrite (strcat "=== DEBUG ENDE " ts " ==="))
(dbg-flush)
(setq *dbg-path* nil)
(setq *dbg-indent* 0)
(prompt "\n[DBG] Debug-Datei geschlossen.")
)
@@ -132,8 +160,8 @@
;; ------------------------------------------------------------
;; DBG-TABS - Hilfsfunktion: Erzeugt Einrueckung
;; ------------------------------------------------------------
(defun dbg-tabs (/ result i)
(setq result "" i 0)
(defun dbg-tabs (/ result)
(setq result "")
(repeat *dbg-indent*
(setq result (strcat result "\t"))
)
@@ -173,13 +201,13 @@
)
;; ------------------------------------------------------------
;; DBGF - Funktionseintritt loggen
;; DBGF - Funktionseintritt loggen (puffert nur)
;; Schreibt "funktionsname(){" und erhoeht Einrueckung
;; ------------------------------------------------------------
(defun dbgf (funcname)
(if (and *dbg-file* *dbg-active*)
(if (and *dbg-path* *dbg-active*)
(progn
(write-line (strcat (dbg-tabs) funcname "(){") *dbg-file*)
(dbg-bufwrite (strcat (dbg-tabs) funcname "(){"))
(setq *dbg-indent* (1+ *dbg-indent*))
)
)
@@ -187,43 +215,46 @@
)
;; ------------------------------------------------------------
;; DBGRETURN - Funktionsaustritt loggen
;; DBGRETURN - Funktionsaustritt loggen + FLUSH auf Platte
;; Verringert Einrueckung und schreibt "} = wert"
;; ------------------------------------------------------------
(defun dbgreturn (retval)
(if (and *dbg-file* *dbg-active*)
(if (and *dbg-path* *dbg-active*)
(progn
(setq *dbg-indent* (max 0 (1- *dbg-indent*)))
(write-line (strcat (dbg-tabs) "} = " (dbg-tostring retval)) *dbg-file*)
(if retval
(dbg-bufwrite (strcat (dbg-tabs) "} = " (dbg-tostring retval)))
(dbg-bufwrite (strcat (dbg-tabs) "}"))
)
(dbg-flush)
)
)
(princ)
)
;; ------------------------------------------------------------
;; DBG - Variable/Wert loggen
;; Schreibt "<tabs> name='wert'"
;; DBG - Variable/Wert loggen (puffert nur)
;; Aufruf: (dbg 'varname) oder (dbg wert)
;; ------------------------------------------------------------
(defun dbg (varname / val)
(if (and *dbg-file* *dbg-active*)
(if (and *dbg-path* *dbg-active*)
(if (= (type varname) 'SYM)
(progn
(setq val (eval varname))
(write-line (strcat (dbg-tabs) (vl-symbol-name varname) "=" (dbg-tostring val)) *dbg-file*)
(dbg-bufwrite (strcat (dbg-tabs) (vl-symbol-name varname) "=" (dbg-tostring val)))
)
(write-line (strcat (dbg-tabs) "value=" (dbg-tostring varname)) *dbg-file*)
(dbg-bufwrite (strcat (dbg-tabs) "value=" (dbg-tostring varname)))
)
)
(princ)
)
;; ------------------------------------------------------------
;; DBGMSG - Freitext-Nachricht loggen
;; DBGMSG - Freitext-Nachricht loggen (puffert nur)
;; ------------------------------------------------------------
(defun dbgmsg (msg)
(if (and *dbg-file* *dbg-active*)
(write-line (strcat (dbg-tabs) ">> " msg) *dbg-file*)
(if (and *dbg-path* *dbg-active*)
(dbg-bufwrite (strcat (dbg-tabs) ">> " msg))
)
(princ)
)
Lisp/ssg_load.lsp
+3 -1
View File
@@ -21,6 +21,8 @@
)
)
(load (strcat base-path "ssg_core.lsp") "ssg_core.lsp nicht gefunden")
(load (strcat base-path "ssg_dbg.lsp") "ssg_dbg.lsp nicht gefunden")
(dbgopen "debugfile.dbg" "DXFM_LOG") ; Debug-Datei im Log-Verzeichnis oeffnen
(load (strcat base-path "ssg_dialog.lsp") "ssg_dialog.lsp nicht gefunden")
(load (strcat base-path "ssg_layer.lsp") "ssg_layer.lsp nicht gefunden")
(load (strcat base-path "KreiselInsert.lsp") "KreiselInsert.lsp nicht gefunden")
@@ -28,7 +30,7 @@
(load (strcat base-path "tests.lsp") "tests.lsp nicht gefunden")
(load (strcat base-path "OmniModulInsert.lsp") "OmniModulInsert.lsp nicht gefunden")
(load (strcat base-path "SSG_LIB_Commands.lsp") "SSG_LIB_Commands.lsp nicht gefunden")
(prompt "\nSSG-Bibliotheken geladen: ssg_core, ssg_dialog, ssg_layer")
(prompt "\nSSG-Bibliotheken geladen: ssg_core, ssg_dbg, ssg_dialog, ssg_layer")
(princ)
)
bin/setenv.bat
+2 -1
View File
@@ -17,7 +17,7 @@ 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_LOG=%DXFMAKRO%\logs"
set "DXFM_BLOCKS=%DXFMAKRO%\Blocks"
set "DXFM_LISP=%DXFMAKRO%\Lisp"
set "DXFM_DCL=%DXFMAKRO%\dcl"
@@ -40,6 +40,7 @@ if not exist "%DXFM_LIB%" mkdir "%DXFM_LIB%"
if not exist "%DXFM_DATA%" mkdir "%DXFM_DATA%"
if not exist "%DXFM_BLOCKS%" mkdir "%DXFM_BLOCKS%"
if not exist "%DXFM_LISP%" mkdir "%DXFM_LISP%"
if not exist "%DXFM_LOG%" mkdir "%DXFM_LOG%"
if not exist "%DXFM_RESULTS%" mkdir "%DXFM_RESULTS%"
REM Umgebungsvariablen anzeigen
dcl/kreisel_edit.dcl
+53
View File
@@ -0,0 +1,53 @@
// ============================================================
// kreisel_edit.dcl - Kreisel Parameter bearbeiten
// Erlaubt das Aendern von Abstand, Hoehe, Ausrichtung,
// Drehrichtung, Typ und Name eines bestehenden Kreisels.
// ============================================================
kreisel_edit : dialog {
label = "Kreisel bearbeiten";
: column {
: edit_box {
key = "name";
label = "Kreiselname:";
edit_width = 30;
}
: row {
: edit_box {
key = "abstand";
label = "Abstand (mm):";
edit_width = 10;
}
: edit_box {
key = "hoehe";
label = "Hoehe (mm):";
edit_width = 10;
}
}
: popup_list {
key = "ausrichtung";
label = "Ausrichtung:";
width = 30;
}
: row {
: popup_list {
key = "drehrichtung";
label = "Motordrehrichtung:";
width = 16;
}
: popup_list {
key = "kreiselart";
label = "Typ:";
width = 16;
}
}
}
ok_cancel;
}
doc/Entwicklungsplan.md
+124
View File
@@ -0,0 +1,124 @@
# Kapitel 1: Meilensteinplanung
## Meilenstein 1: ILS für die Projektierung
- ILS Kreisel DONE
- ILS Eckrad DONE
- ILS Varioförder DONE
- ILS Gefällestrecke
- ILS Weichen
- ILS Horizontalvariobögen (30,60,90 r und l, innen und aussen angetrieben)
- ILS Gefällebögen (30,60,90 r und l)
- BTMT Beladung und Entladung
- CSV Export aller ILS Elemente
## Meilenstein 2: Ersatz von Bihler Gerüst
- Gerüst
+ Abhänger (3 Quetschung, 6 Abhängung oben, 4 Abhängung unten, 4 Befestiung oben, 3 Farben, Variable Länge)
+ T-Abhänger mit Flansch-Rohr (3 Spannpratze, 3 Farben, Variable Länge)
+ Säulen (2 Arten, 3 Farben, 2 Einbauwinkel Platte, 5 Haltearm, 4 Einbauwinkel Arm, 8 Klemmring, Länge Bodensäule)
+ Wandbefestigung (4 Varianten, 3 Befestigungen)
+ Träger (RT/DRT) - (4 Varianten, 3 Farben, Muffe, Längenabzug Anfang/Ende)
- CSV Export aller Gerüst Komponenten
- TOS von Gerüst-Import ins Sivas
## Meilenstein 3: Ersatz von Bihler Omniflo
- Omniflo Bögen (27) DONE
- Omniflo Weichen (80) DONE
- Omniflo Verbinder (18 Varianten)
- Kettenförderer (3 Teile: Ein/Auslauf und Verbindung)
- TEF Geraden aus Omniflo Geraden (Umwandlungsmakro)
- CSV Export aller Omniflo Elemente
## Meilenstein 4: Flex
- Erstellung der .dwg Dateien von Bögen, Geraden, Förderer
- Definition des Produktprogrammes
- CSV Export aller Flex Elemente
- TOS von Flex Elementen
## Meilenstein 5: 3D Modelle einer Anlage (Erzeugung von .dwg Files)
- Omniflo Bogen, Weiche
- Gerüst Modelle Abhänger, Säulen, usw.
## Meilenstein 6: Metafunktionen
- Erzeugung eines Gerüsts über einem Bereich/ einer Strecke
- Erzeugung einer Strecke aus einer Polylinie
- Erzeugung eines Puffers aus einer Flächenangabe/Recheck
- Positionierung von Separatoren und Scannern aus dem Streckenverlauf/Fördereranbindung
- Makro zur Erzeugung eines Arbeitsplatzes (Varioförderer ab, 180 Grad Bogen, Varoförderer auf)
- Varioförder als Etagenförderer (anderer ES und AS Elemente)
---
# Kapitel 2: Aufwandsschätzung und Resourcenplanung
## Resourcen
| Kürzel | Person |
| ------ | ------ |
| YW | Y.Wang |
| SH | S.Hensch |
| MS | M.Stangl |
## Meilenstein 1: ILS für die Projektierung
| Tätigkeit | Aufwand [h] | Person |
|-----------|-------------|--------|
| ILS Kreisel | - | - |
| ILS Eckrad | - | - |
| ILS Varioförder | - | - |
| ILS Gefällestrecke | | |
| ILS Weichen | | |
| ILS Horizontalvariobögen (30,60,90 r und l, innen und aussen angetrieben) | | |
| ILS Gefällebögen (30,60,90 r und l) | | |
| BTMT Beladung und Entladung | | |
| CSV Export aller ILS Elemente | | |
## Meilenstein 2: Ersatz von Bihler Gerüst
| Tätigkeit | Aufwand [h] | Person |
|-----------|-------------|--------|
| Gerüst Abhänger (3 Quetschung, 6 Abhängung oben, 4 Abhängung unten, 4 Befestiung oben, 3 Farben, Variable Länge) | | |
| Gerüst T-Abhänger mit Flansch-Rohr (3 Spannpratze, 3 Farben, Variable Länge) | | |
| Gerüst Säulen (2 Arten, 3 Farben, 2 Einbauwinkel Platte, 5 Haltearm, 4 Einbauwinkel Arm, 8 Klemmring, Länge Bodensäule) | | |
| Gerüst Wandbefestigung (4 Varianten, 3 Befestigungen) | | |
| Gerüst Träger (RT/DRT) - (4 Varianten, 3 Farben, Muffe, Längenabzug Anfang/Ende) | | |
| CSV Export aller Gerüst Komponenten | | |
| TOS von Gerüst-Import ins Sivas | | |
## Meilenstein 3: Ersatz von Bihler Omniflo
| Tätigkeit | Aufwand [h] | Person |
|-----------|-------------|--------|
| Omniflo Bögen (27) | - | - |
| Omniflo Weichen (80) | - | - |
| Omniflo Verbinder (18 Varianten) | | |
| Kettenförderer (3 Teile: Ein/Auslauf und Verbindung) | | |
| TEF Geraden aus Omniflo Geraden (Umwandlungsmakro) | | |
| CSV Export aller Omniflo Elemente | | |
## Meilenstein 4: Flex
| Tätigkeit | Aufwand [h] | Person |
|-----------|-------------|--------|
| Erstellung der .dwg Dateien von Bögen, Geraden, Förderer | | |
| Definition des Produktprogrammes | | |
| CSV Export aller Flex Elemente | | |
| TOS von Flex Elementen | | |
## Meilenstein 5: 3D Modelle einer Anlage (Erzeugung von .dwg Files)
| Tätigkeit | Aufwand [h] | Person |
|-----------|-------------|--------|
| Omniflo Bogen, Weiche | | |
| Gerüst Modelle Abhänger, Säulen, usw. | | |
## Meilenstein 6: Metafunktionen
| Tätigkeit | Aufwand [h] | Person |
|-----------|-------------|--------|
| Erzeugung eines Gerüsts über einem Bereich/einer Strecke | | |
| Erzeugung einer Strecke aus einer Polylinie | | |
| Erzeugung eines Puffers aus einer Flächenangabe/Recheck | | |
| Positionierung von Separatoren und Scannern aus dem Streckenverlauf/Fördereranbindung | | |
| Makro zur Erzeugung eines Arbeitsplatzes (Varioförderer ab, 180 Grad Bogen, Varoförderer auf) | | |
| Varioförder als Etagenförderer (anderer ES und AS Elemente) | | |