Undo Funktion mit ssg-start und ssg-end verwendet. Routinen standardisiert
This commit is contained in:
+121
-167
@@ -555,61 +555,16 @@
|
||||
|
||||
;; --- 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
|
||||
;; 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")
|
||||
@@ -619,134 +574,142 @@
|
||||
dx dy angle angleDeg
|
||||
textEnt textHeight textGap
|
||||
perpX perpY textPt ed
|
||||
lastEnt ss e bname blockEnt attribs
|
||||
oldOsnap oldCmdEcho oldLayer oldAttreq oldAttdia
|
||||
lastEnt ss e bname blockEnt
|
||||
srcAttribs attribDefs attribs
|
||||
ok)
|
||||
|
||||
(setq textHeight 100.0)
|
||||
(setq textGap 20.0)
|
||||
|
||||
(setq pt (getpoint "\nEinfuegepunkt waehlen: "))
|
||||
(if (null pt)
|
||||
(progn (princ "\n[OMNI] Abgebrochen.") nil)
|
||||
;; 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
|
||||
;; Einstellungen sichern
|
||||
(setq oldOsnap (getvar "OSMODE"))
|
||||
(setq oldCmdEcho (getvar "CMDECHO"))
|
||||
(setq oldLayer (getvar "CLAYER"))
|
||||
(setvar "CMDECHO" 0)
|
||||
;; 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))))
|
||||
)
|
||||
|
||||
;; 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))
|
||||
(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)
|
||||
|
||||
;; 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!"))
|
||||
;; 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
|
||||
(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))
|
||||
;; 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
|
||||
(setq lastEnt textEnt)
|
||||
;; 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) "")
|
||||
;; 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)
|
||||
;; 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)))
|
||||
;; 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 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 (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)
|
||||
;; Block einfuegen (ATTREQ/ATTDIA bereits auf 0)
|
||||
(command "_.INSERT" bname pt 1 1 angleDeg)
|
||||
|
||||
(setq blockEnt (entlast))
|
||||
(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)
|
||||
;; 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)))
|
||||
;; 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 (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)
|
||||
)
|
||||
)
|
||||
(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)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(ssg-end)
|
||||
pt
|
||||
)
|
||||
)
|
||||
|
||||
;; Einstellungen wiederherstellen
|
||||
(setvar "OSMODE" oldOsnap)
|
||||
(setvar "CMDECHO" oldCmdEcho)
|
||||
(setvar "CLAYER" oldLayer)
|
||||
pt
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -956,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
|
||||
@@ -976,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
|
||||
)
|
||||
)
|
||||
|
||||
Reference in New Issue
Block a user