diff --git a/Blocks/AP110.dwg b/Blocks/AP110.dwg new file mode 100644 index 0000000..57fb5e1 Binary files /dev/null and b/Blocks/AP110.dwg differ diff --git a/Blocks/AP60.dwg b/Blocks/AP60.dwg new file mode 100644 index 0000000..1f83755 Binary files /dev/null and b/Blocks/AP60.dwg differ diff --git a/Blocks/APG110.dwg b/Blocks/APG110.dwg new file mode 100644 index 0000000..6b3fa8f Binary files /dev/null and b/Blocks/APG110.dwg differ diff --git a/Lisp/KreiselInsert.lsp b/Lisp/KreiselInsert.lsp index 0feef3c..43dd684 100644 --- a/Lisp/KreiselInsert.lsp +++ b/Lisp/KreiselInsert.lsp @@ -353,8 +353,7 @@ ;; --- Block am Zielpunkt einfuegen (ohne Attribut-Dialog) --- ;; basePoint kann 2D oder 3D sein; INSERT uebernimmt die Z-Koordinate - (setq oldAttreq (getvar "ATTREQ")) - (setq oldAttdia (getvar "ATTDIA")) + ;; ATTREQ/ATTDIA werden durch ssg-start/ssg-end der Aufrufer gesichert (setvar "ATTREQ" 0) (setvar "ATTDIA" 0) diff --git a/Lisp/OmniModulInsert.lsp b/Lisp/OmniModulInsert.lsp index 1830da6..6c7be8d 100644 --- a/Lisp/OmniModulInsert.lsp +++ b/Lisp/OmniModulInsert.lsp @@ -554,8 +554,176 @@ ) ;; --- Omniflo / Aluprofil Gerade --- + +;; Aluprofil-Fahrstrecke einfuegen. +;; +;; Ablauf: +;; 1. Quell-Block (.dwg) temporaer einfuegen, Attribute lesen, loeschen +;; 2. Nutzer waehlt Einfuegepunkt -> Text "blockname" wird horizontal platziert +;; 3. Nutzer klickt Endpunkt -> Linie definiert Fahrstreckenlaenge und Richtung +;; 4. Laenge wird gegen laengemax geprueft (Fehlermeldung bei Ueberschreitung) +;; 5. Compound-Block aus Linie + ATTDEFs (mit Quell-Werten) wird erzeugt +;; Blockname: blockname_YYYYMMDDHHMMSS +;; 6. Text wird gedreht, oberhalb der Linie positioniert, Inhalt aktualisiert +;; z.B. "APG110 L=2879" +;; +;; blockname = Profiltyp (z.B. "AP60", "AP110", "APG110") +;; laengemax = Maximale Fahrstreckenlaenge in mm +(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) + + (setq textHeight 100.0) + (setq textGap 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"))) + (if (null srcAttribs) + (progn (princ "\n[OMNI] Keine Attribute im Quell-Block gefunden.") nil) + (progn + ;; LAENGEMAX aus Quell-Attribut lesen (falls vorhanden), sonst Parameter + (if (and (assoc "LAENGEMAX" srcAttribs) + (> (strlen (cdr (assoc "LAENGEMAX" srcAttribs))) 0)) + (setq laengemax (atof (cdr (assoc "LAENGEMAX" srcAttribs)))) + ) + + (setq pt (getpoint "\nEinfuegepunkt waehlen: ")) + (if (null pt) + (progn (princ "\n[OMNI] Abgebrochen.") nil) + (progn + (ssg-start "OMNI Aluprofil" '(("OSMODE") ("ATTREQ") ("ATTDIA"))) + ;; ATTREQ/ATTDIA auf 0 setzen (werden durch ssg-end wiederhergestellt) + (setvar "ATTREQ" 0) + (setvar "ATTDIA" 0) + + ;; 1. Text horizontal am Einfuegepunkt erzeugen + (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)) + + ;; 2. Endpunkt fuer Fahrstrecke abfragen (Schleife bei Ueberschreitung) + (setq ok nil) + (while (not ok) + (setq pt2 (getpoint pt "\nEndpunkt der Fahrstrecke waehlen: ")) + (if (null pt2) + (progn + ;; Abbruch: Text loeschen + (command "_.ERASE" textEnt "") + (princ "\n[OMNI] Abgebrochen.") + (setq ok T pt nil) + ) + (progn + (setq laenge (distance (list (car pt) (cadr pt)) + (list (car pt2) (cadr pt2)))) + (if (> laenge laengemax) + (alert (strcat "Die gewuenschte Fahrstreckenlaenge von " + (rtos laenge 2 0) " mm ueberschreitet die Maximallaenge von " + (rtos laengemax 2 0) " mm des Fahrstreckenprofils.\n" + "Bitte neu definieren!")) + (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))))) + ) + (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) + + (princ (strcat "\n[OMNI] " bname " eingefuegt. Laenge=" laengeStr " mm")) + (setq ok T) + ) + ) + ) + ) + ) + + (ssg-end) + pt + ) + ) + ) + ) +) + +(defun c:OMNI_AP60 () + (omni:insert-block "AP60" 7000.0) + (princ) +) (defun c:OMNI_AP110 () - (princ "\n[DUMMY] AP 110 Aluprofil Gerade") + (omni:insert-block "AP110" 6000.0) + (princ) +) +(defun c:OMNI_APG110 () + (omni:insert-block "APG110" 6000.0) (princ) ) @@ -751,8 +919,7 @@ ;; --- DXF-Datei als Block einfuegen --- ;; sivasnr-str = SivasNr als String (Dateiname ohne .dxf) ;; Rueckgabe: Einfuegepunkt oder nil bei Abbruch -(defun omni:insert-dxf (sivasnr-str / dxf-pfad data-pfad pt - oldOsnap oldCmdEcho oldLayer) +(defun omni:insert-dxf (sivasnr-str / dxf-pfad data-pfad pt) (setq data-pfad (getenv "DXFM_DATA")) (if (null data-pfad) (progn @@ -771,21 +938,13 @@ (if (null pt) (progn (princ "\n[OMNI] Abgebrochen.") nil) (progn - ;; Einstellungen sichern - (setq oldOsnap (getvar "OSMODE")) - (setq oldCmdEcho (getvar "CMDECHO")) - (setq oldLayer (getvar "CLAYER")) - (setvar "CMDECHO" 0) + (ssg-start "OMNI DXF Insert" '(("OSMODE"))) ;; Block einfuegen mit Winkelabfrage (pause) (command "_.INSERT" dxf-pfad pt "" "" pause) - ;; Einstellungen wiederherstellen - (setvar "OSMODE" oldOsnap) - (setvar "CMDECHO" oldCmdEcho) - (setvar "CLAYER" oldLayer) - (princ (strcat "\n[OMNI] " sivasnr-str " eingefuegt.")) + (ssg-end) pt ) ) diff --git a/Lisp/ssg_core.lsp b/Lisp/ssg_core.lsp index 5ce0e8a..a2792b0 100644 --- a/Lisp/ssg_core.lsp +++ b/Lisp/ssg_core.lsp @@ -181,6 +181,15 @@ ;; BLOCK-OPERATIONEN ;; ------------------------------------------------------------ +;; Zeitstempel als YYYYMMDDHHMMSS erzeugen (fuer eindeutige Blocknamen) +(defun ssg-timestamp ( / cd ds ts) + (setq cd (rtos (getvar "CDATE") 2 6)) + ;; cd = "20260518.143052" -> Punkt entfernen + (setq ds (substr cd 1 8)) + (setq ts (substr cd 10 6)) + (strcat ds ts) +) + ;; Eindeutigen Blocknamen aus Einfuegepunkt + Zeitstempel erzeugen ;; pt = Einfuegepunkt (Liste); Rueckgabe: Blockname als String (defun ssg-make-blockname (pt / k1 k2) @@ -347,6 +356,69 @@ ) ) +;; Attribute eines bestimmten INSERT-Entity setzen (nicht entlast). +;; ent = Entity-Name des INSERT-Blocks +;; attrib-alist = (("TAG" . "Wert") ...) +(defun ssg-attrib-set-on (ent attrib-alist / obj ed typ tag wert) + (setq obj (entnext ent)) + (while obj + (setq ed (entget obj)) + (setq typ (cdr (assoc 0 ed))) + (if (equal typ "SEQEND") (setq obj nil) + (progn + (if (equal typ "ATTRIB") + (progn + (setq tag (cdr (assoc 2 ed))) + (setq wert (cdr (assoc tag attrib-alist))) + (if (and wert (> (strlen wert) 0)) + (progn + (entmod (subst (cons 1 wert) (assoc 1 ed) ed)) + (entupd obj) + ) + ) + ) + ) + (setq obj (entnext obj)) + ) + ) + ) +) + +;; Assoziationsliste in ATTDEF-Definitionsliste konvertieren. +;; alist = (("TAG" . "Wert") ...) -> ((TAG Wert) ...) +;; Passend fuer ssg-attrib-make-defs. +(defun ssg-attrib-alist-to-defs (alist / result) + (foreach pair alist + (setq result (cons (list (car pair) (cdr pair)) result)) + ) + (reverse result) +) + +;; Block (.dwg) temporaer einfuegen, Attribute lesen, Block loeschen. +;; dwg-pfad = vollstaendiger Pfad zur .dwg Datei +;; Rueckgabe: Assoziationsliste (("TAG" . "Wert") ...) oder nil +(defun ssg-attrib-read-dwg (dwg-pfad / tmpEnt srcAttribs oldAttreq oldAttdia) + (if (not (findfile dwg-pfad)) + (progn + (princ (strcat "\nFEHLER: Block nicht gefunden: " dwg-pfad)) + nil + ) + (progn + (setq oldAttreq (getvar "ATTREQ")) + (setq oldAttdia (getvar "ATTDIA")) + (setvar "ATTREQ" 0) + (setvar "ATTDIA" 0) + (command "_.INSERT" dwg-pfad (list 0.0 0.0 0.0) 1 1 0) + (setvar "ATTREQ" oldAttreq) + (setvar "ATTDIA" oldAttdia) + (setq tmpEnt (entlast)) + (setq srcAttribs (ssg-attrib-read tmpEnt)) + (command "_.ERASE" tmpEnt "") + srcAttribs + ) + ) +) + ;; Attribut eines Blocks anhand seines Handle suchen und aendern ;; handle = Entity-Handle (String) des INSERT ;; tag = Attributbezeichner diff --git a/menu/SSG_LIB.mnu b/menu/SSG_LIB.mnu index 30cafe9..e68a852 100644 --- a/menu/SSG_LIB.mnu +++ b/menu/SSG_LIB.mnu @@ -46,7 +46,9 @@ [22.5]^C^COMNI_APB_550_225 [<-180 ]^C^COMNI_APB_650_180 [->Aluprofil Gerade] -[<-AP 110]^C^COMNI_AP110 +[AP 60]^C^COMNI_AP60 +[AP 110]^C^COMNI_AP110 +[<-APG 110]^C^COMNI_APG110 [->Weiche 90 Grad] [Einfach 90 700/700 links M]^C^COMNI_W90_Einfach [Doppel 90 700/700 M]^C^COMNI_W90_Doppel