Erste FAssung für ein Makro für die Geraden erzeugt

This commit is contained in:
2026-05-18 13:50:23 +02:00
parent aeef67f2c3
commit e801c84439
5 changed files with 209 additions and 2 deletions
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
+206 -1
View File
@@ -554,8 +554,213 @@
) )
;; --- Omniflo / Aluprofil Gerade --- ;; --- Omniflo / Aluprofil Gerade ---
;; Attribut-Definitionen fuer Aluprofil-Bloecke: ((TAG DEFAULT) ...)
;; LAENGE und LAENGEMAX werden automatisch gesetzt.
(setq *omni-profil-attrib-defs*
'(("ETIKETTE" "")
("AUFLOESE" "")
("GRUPPE" "")
("A" "")
("B" "")
("C" "")
("BESCHR" "")
("ARTINR" "")
("MENGE" "")
("POSITION" "")
("LAENGE" "")
("LAYER" "")
("TLAGE" "")
("LAENGEMAX" ""))
)
;; Attribute eines bestimmten INSERT-Entity setzen.
;; ent = Entity-Name des INSERT-Blocks
;; attrib-alist = (("TAG" . "Wert") ...)
(defun omni: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))
)
)
)
)
;; Aluprofil-Fahrstrecke einfuegen.
;;
;; Ablauf:
;; 1. Nutzer waehlt Einfuegepunkt -> Text "blockname" wird horizontal platziert
;; 2. Nutzer klickt Endpunkt -> Linie definiert Fahrstreckenlaenge und Richtung
;; 3. Laenge wird gegen laengemax geprueft (Fehlermeldung bei Ueberschreitung)
;; 4. Compound-Block aus Linie + Attributen wird erzeugt und eingefuegt
;; 5. Text wird gedreht, verschoben (oberhalb Linie) und 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 attribs
oldOsnap oldCmdEcho oldLayer oldAttreq oldAttdia
ok)
(setq textHeight 100.0)
(setq textGap 20.0)
(setq pt (getpoint "\nEinfuegepunkt waehlen: "))
(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)
;; 1. Text horizontal am Einfuegepunkt erzeugen (per entmake)
(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 "")
(setvar "OSMODE" oldOsnap)
(setvar "CMDECHO" oldCmdEcho)
(setvar "CLAYER" oldLayer)
(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
(setq lastEnt textEnt)
;; Linie von Ursprung bis (laenge, 0)
(command "_.LINE" (list 0.0 0.0) (list laenge 0.0) "")
;; Unsichtbare Attribut-Definitionen
(ssg-attrib-make-defs *omni-profil-attrib-defs* 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 erzeugen
(setq bname (strcat blockname "_"
(ssg-make-blockname
(list (car pt) (cadr pt)
(if (caddr pt) (caddr pt) 0.0)))))
(command "_.-BLOCK" bname (list 0.0 0.0 0.0) ss "")
;; Block einfuegen (ohne Attribut-Dialog)
(setq oldAttreq (getvar "ATTREQ"))
(setq oldAttdia (getvar "ATTDIA"))
(setvar "ATTREQ" 0)
(setvar "ATTDIA" 0)
(command "_.INSERT" bname pt 1 1 angleDeg)
(setvar "ATTREQ" oldAttreq)
(setvar "ATTDIA" oldAttdia)
(setq blockEnt (entlast))
;; 4. Attribute setzen
(setq attribs (ssg-attrib-merge
(list (cons "LAENGE" laengeStr)
(cons "A" laengeStr)
(cons "LAENGEMAX" (rtos laengemax 2 0)))
*omni-profil-attrib-defs*))
(omni: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] " blockname " eingefuegt. Laenge=" laengeStr " mm"))
(setq ok T)
)
)
)
)
)
;; Einstellungen wiederherstellen
(setvar "OSMODE" oldOsnap)
(setvar "CMDECHO" oldCmdEcho)
(setvar "CLAYER" oldLayer)
pt
)
)
)
(defun c:OMNI_AP60 ()
(omni:insert-block "AP60" 7000.0)
(princ)
)
(defun c:OMNI_AP110 () (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) (princ)
) )
+3 -1
View File
@@ -46,7 +46,9 @@
[22.5]^C^COMNI_APB_550_225 [22.5]^C^COMNI_APB_550_225
[<-180 ]^C^COMNI_APB_650_180 [<-180 ]^C^COMNI_APB_650_180
[->Aluprofil Gerade] [->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] [->Weiche 90 Grad]
[Einfach 90 700/700 links M]^C^COMNI_W90_Einfach [Einfach 90 700/700 links M]^C^COMNI_W90_Einfach
[Doppel 90 700/700 M]^C^COMNI_W90_Doppel [Doppel 90 700/700 M]^C^COMNI_W90_Doppel