; afkoordinaten.lsp Lisp-datei zum Zeichnen von Koordinaten an Ansichtsfenster ; erstellt 12/03 Th.J. ; 06/07 einfaches Errorhandling hinzugefuegt ; 06/07 Fehler bei Abweichung von Koordinatenrichtung und Winkeleinheiten beseitigt ; 09/07 Auswahl ob Anschreiben innen oder aussen vom AF ; ; Vorhaben: waehle Ansichtsfenter und zeichne im Plotbereich an das AF die Koordinaten (Linien und Werte) ; des dargestellten (Lage)planausschnittes ; ; (princ "Start mit afkoord") ; Errorhandling (defun my_error (msg) (print (strcat "Fehler aufgetreten: " msg)) (command "_undo" "_back") (setq *error* alterror) (setvar "blipmode" sblip) (setvar "cmdecho" scmde) (setvar "osmode" sosmode) (setvar "angbase" sangbase) (setvar "angdir" sangdir) (setvar "aunits" saunits) (setvar "aperture" aperturewert) ; von MH eingefügt (setvar "autosnap" pkwsnap) ; von MH eingefügt (princ) ) ;(DEFUN C:ele () ; gefunden in lisp-forum von cad.de ; (defun #VPT_BOX ( $view / ; Ename of viewport v_eed ; Viewport entity list including EED v_psw ; Paper space width v_psh ; height v_msw ; Model space width v_msh ; height v_msxp ; view centre x point v_msyp ; y point v_ang ; twist angle v_xy1 ; left bottom point v_xy2 ; right bottom point v_xy3 ; right top point v_xy4 ; left top point v_scale ; scale #ent_gc ; Local function ) (defun #ENT_GC ( $gc $list ) ; Return group code from list (cdr (assoc $gc $list)) ; | );end defun #ENT_GC ; | (defun #TRG_ROT ( $point ; 2D point ; Rotate point $angle ; Angle in radians ; | $offsetx ; x of offset $offsety / ; y of offset x y ; x & y of $point ; | ca sa ; cos/sin of $angle; | ) ; | (setq x (car $point) ; | y (cadr $point) ; | ca (cos $angle) ; | sa (sin $angle) ; | ) ; | (list (+ (- (* x ca) (* y sa)) $offsetx) ; | (+ (* x sa) (* y ca) $offsety) ; | ) ; | );end defun #TRG_ROT ; | ; **** MAIN BODY **** (if (and (= 'ENAME (type $view)) ; if Ename passed and... (setq v_eed (entget $view '("ACAD"))) ; .. got entity list and... (= "VIEWPORT" (#ent_gc 0 v_eed)) ; .. is viewport ) ; | (progn ; | (setq v_psw (#ent_gc 40 v_eed) ; | paper space width v_psh (#ent_gc 41 v_eed) ; | paper space height v_eed (cdar (#ent_gc -3 v_eed)) ; | extended entity data ; take ms dest. point into account (GC 17, EED 1010) (offset of coord-systems) v_eed_dp (member (assoc 1010 v_eed) v_eed) v_dpxy (#ent_gc 1010 v_eed_dp) v_dpx (car v_dpxy) v_dpy (cadr v_dpxy) ; end of dest.point data v_eed (member ; | discard EED before twist angle (assoc 1040 v_eed) v_eed ; | | ) ; | | v_ang (#ent_gc 1040 v_eed) ; | 1st gc 1040 (twist angle) v_eed (cdr v_eed) ; | remainder of eed v_msh (#ent_gc 1040 v_eed) ; | 2nd gc 1040 (view height) v_eed (cdr v_eed) ; | remainder of eed v_msxp (#ent_gc 1040 v_eed) ; | 3rd gc 1040 (view x point) v_eed (cdr v_eed) ; | remainder of eed v_msyp (#ent_gc 1040 v_eed) ; | 4th gc 1040 (view y point) v_scale (/ v_psh v_msh) ; | scale v_msw (/ v_psw v_scale) ; | ms width v_xy1 (list (- v_msxp (/ v_msw 2.0)) ; | ms left border and ... (- v_msyp (/ v_msh 2.0)) ; | bottom border ) ; | ) ; | (setq v_ang (- (* 2.0 pi) v_ang) ; | v_xy1 (#trg_rot v_xy1 v_ang v_dpx v_dpy) ; | 1st point v_xy2 (polar v_xy1 v_ang v_msw) ; | 2nd point v_ang (+ v_ang (/ pi 2.0)) ; | turn 90 deg v_xy3 (polar v_xy2 v_ang v_msh) ; | 3rd point v_ang (+ v_ang (/ pi 2.0)) ; | turn 90 deg v_xy4 (polar v_xy3 v_ang v_msw) ; | 4th point ) ; | (PRINC v_msxp) (TERPRI) (PRINC v_msyp) (TERPRI) (list v_xy1 v_xy2 v_xy3 v_xy4) ; | corner points );end progn ; | );end if ; end if );end defun #VPT_BOX ; (defun antwort(frage antw1 antw2 / antw kw) (setq kw (strcat antw1 " " antw2)) (initget 1 kw) (setq antw (substr (getkword frage) 1 1)) ) ; ende defun antwort ; jetzt gehts los ; (defun C:afkoord( / alterror sblip scmd sosmode al anz x axl zen_af zen_af_x zen_af_y zen_modw zen_mod_xw zen_mod_yw br_af h_af h_mod affakt br_mod alpha liun_af_x liob_af_x reun_af_x reob_af_x liun_af_y liob_af_y reun_af_y reob_af_y element punkte liun_mb liob_mb reun_mb reob_mb liun_mb_x liob_mb_x reun_mb_x reob_mb_x liun_mb_y liob_mb_y reun_mb_y reob_mb_y startx starty delta_l delta_m delta_a cy_af richtg textht textri textausri cx_mb minx maxx delta_m1 cx_af ctext p1 p2 pt cy_mb miny maxy ) (setq alterror *error*) (setq *error* my_error) (command "_undo" "_mark") (print "Ansichtsfensterkoordinaten") ; ; ein paar vorbereitungen ; (setq sblip (getvar "blipmode")) (setq scmde (getvar "cmdecho")) (setq sosmode (getvar "osmode")) (setq sangbase (getvar "angbase")) (setq sangdir (getvar "angdir")) (setq saunits (getvar "aunits")) (setq pkwsnap (getvar "autosnap")) ; von MH eingefügt (setq aperturewert (getvar "aperture")) ; von MH eingefügt (setvar "blipmode" 0) (setvar "cmdecho" 0) (setvar "osmode" 0) (setvar "angbase" 0) (setvar "angdir" 0) (setvar "aunits" 0) (setvar "aperture" 1) ; von MH eingefügt (setvar "autosnap" 0) ; von MH eingefügt (command "ofang" "keiner") ; von MH eingefügt ; waehle Fenster (setq anz 0 al (ssget '((0 . "VIEWPORT")))) ;(setq anz (sslength al)) (if al (setq anz (sslength al)) (print "kein Ansichtsfenster gewaehlt")) (setq x 0) (while (< x anz) (setq axl (entget (ssname al x))) ; ; pruefen ob ansichtsfenster ; (if (= "VIEWPORT" (cdr (assoc 0 axl))) (progn (setq zen_af (cdr (assoc 10 axl))) (setq zen_af_x (car zen_af)) (setq zen_af_y (cadr zen_af)) (setq zen_modw (cdr (assoc 12 axl))) (setq zen_mod_xw (car zen_modw)) (setq zen_mod_yw (cadr zen_modw)) (setq br_af (cdr (assoc 40 axl))) (setq h_af (cdr (assoc 41 axl))) (setq h_mod (cdr (assoc 45 axl))) (setq affakt (/ h_af h_mod)) (setq br_mod (/ br_af affakt)) (setq alpha (cdr (assoc 51 axl))) ; ; ; eckpunkte ansichtsfenster (annahme nicht gedreht) ; (setq liun_af_x (- zen_af_x (/ br_af 2.))) (setq liob_af_x (- zen_af_x (/ br_af 2.))) (setq reun_af_x (+ zen_af_x (/ br_af 2.))) (setq reob_af_x (+ zen_af_x (/ br_af 2.))) (setq liun_af_y (- zen_af_y (/ h_af 2.))) (setq liob_af_y (+ zen_af_y (/ h_af 2.))) (setq reun_af_y (- zen_af_y (/ h_af 2.))) (setq reob_af_y (+ zen_af_y (/ h_af 2.))) ; ; OK bis hier, nun koordinaten der Eckpunkte fuer Modellbereich ermitteln ; ; dafür haben wir im lisp forum etwas gefunden ; (setq element (cdr (assoc -1 axl))) (SETQ punkte (#VPT_BOX element)) ; ; punkte extrahieren ; (setq liun_mb (nth 0 punkte)) (setq reun_mb (nth 1 punkte)) (setq reob_mb (nth 2 punkte)) (setq liob_mb (nth 3 punkte)) (setq liun_mb_x (car liun_mb)) (setq liun_mb_y (cadr liun_mb)) (setq liob_mb_x (car liob_mb)) (setq liob_mb_y (cadr liob_mb)) (setq reun_mb_x (car reun_mb)) (setq reun_mb_y (cadr reun_mb)) (setq reob_mb_x (car reob_mb)) (setq reob_mb_y (cadr reob_mb)) ; ; Ausgabe Extremwerte und Abfrage Startwerte und Schrittweiten ; (print "Mininmal- und Maximalwert x ") (setq minimal_mb_X (princ (min liun_mb_x liob_mb_x reun_mb_x reob_mb_x))) ;von MH geändert (princ " ") (princ " ") (setq maximal_mb_X (princ (max liun_mb_x liob_mb_x reun_mb_x reob_mb_x))) ;von MH geändert (print "Mininmal- und Maximalwert y") (setq minimal_mb_Y (princ (min liun_mb_y liob_mb_y reun_mb_y reob_mb_y))) ;von MH geändert (princ " ") (princ " ") (setq maximal_mb_y (princ (max liun_mb_y liob_mb_y reun_mb_y reob_mb_y))) ;von MH geändert (terpri) (initget 1) (setq startx (getreal "Startwert fuer x-Koordinaten angeben ")) (setq starty (getreal "Startwert fuer y-Koordinaten angeben ")) (initget 3) (setq delta_l (fix (getreal "Schrittweite fuer Koordinaten angeben "))) ; von MH geändert (setq masstab (getreal "Maßstab Ansichtsfenter: 1 : ? ")) ; von MH eingefügt (setq lraussen (= (antwort "\nKoordinatenanschrieb Innen/Aussen des AF [I/A] :" "Innen" "Aussen") "A")) ; Gitterkreuzanzahl und Größe berechnen, von MH eingefügt (setq startx (* (fix (/ minimal_mb_X delta_l)) delta_l)) ; von MH eingefügt (setq starty (* (fix (/ minimal_mb_Y delta_l)) delta_l)) ; von MH eingefügt (setq ende_x (* (fix (/ maximal_mb_X delta_l)) delta_l)) ; von MH eingefügt (setq ende_y (* (fix (/ maximal_mb_Y delta_l)) delta_l)) ; von MH eingefügt (setq kreuzanzahlx (fix (+ (/ (- ende_x startx) delta_l) 1))) ; von MH eingefügt (setq kreuzanzahly (fix (+ (/ (- ende_y starty) delta_l) 1))) ; von MH eingefügt (setq kreuzhoehe (/ masstab 1000.0)) ; von MH eingefügt ; ; Werte pruefen und setzen (lassen wir noch offen) ;;;;********************* von MH eingefügt***************************Anfang ;Neue Layer anlegen (command "layer" "neu" "OCG_AF_Koor_Linie" "Farbe" 7 "OCG_AF_Koor_Linie" "") (command "layer" "neu" "OCG_AF_Koor_Linie_X" "Farbe" 7 "OCG_AF_Koor_Linie_X" "") (command "layer" "neu" "OCG_AF_Koor_Linie_Y" "Farbe" 7 "OCG_AF_Koor_Linie_Y" "") (command "layer" "neu" "OCG_AF_Koor_Hintergrund" "Farbe" 255 "OCG_AF_Koor_Hintergrund" "") (command "layer" "neu" "OCG_AF_Koor_Text_X" "Farbe" 7 "OCG_AF_Koor_Text_X" "") (command "layer" "neu" "OCG_AF_Koor_Text_Y" "Farbe" 7 "OCG_AF_Koor_Text_Y" "") (command "layer" "neu" "OCG_AF_Koor_Kreuz" "Farbe" 7 "OCG_AF_Koor_Kreuz" "") (command "löschen" (ssget "X" (list (cons 8 "OCG_AF_Koor_*")))"") (command "modell" "") (command "löschen" (ssget "X" (list (cons 8 "OCG_AF_Koor_Kreuz")))"") (command "bereinig" "blöcke" "GK-kreuz" "n" "") (command "layout" "" "") (command "zoom" "o" al "") ;Gitterkreuze erzeugen (setq delta_m (- reun_mb_x liun_mb_x)) ; dargestellte Koord.diff im ;Modellb. (setq delta_a (- reun_af_x liun_af_x)) ; dargestellte Koord.diff im ;Ansichtsf. (setq delta_ma (/ delta_m delta_a)) (setq delta_m nil) (setq delta_a nil) (command "modell" "") (command "layer" "setzen" "OCG_AF_Koor_Kreuz" "") ;(if (not (tblsearch "BLOCK" "GK-kreuz")) ;wenn keine Blockdefinition vorhanden ;(progn (setq startxy (list (- startx 2.5) starty)) (command "linie" startxy "@5,0" "") (setq liniehor (entlast)) (setq startxy (list startx (- starty 2.5))) (command "linie" startxy "@0,5" "") (setq liniever (entlast)) (setq kreuz (ssadd liniehor)) (ssadd liniever kreuz) (setq startxy (list startx starty)) (command "block" "GK-kreuz" startxy kreuz "") ;)) (command "_insert" "GK-kreuz" startxy kreuzhoehe kreuzhoehe "0" "") (ssadd (entlast) kreuz) (command "reihe" kreuz "" "R" kreuzanzahly kreuzanzahlx delta_l delta_l "") )) (command "layout" "" "") ;;; Jetzt werden die im Ansichtsfenster sichtbaren Koordinaten Gitterkreuze in den Ansichtsfensterbereich verschoben. Alle übrigen im Modellbereich werden wieder gelöscht (command "_mspace") (setq Auswahl (ssget "_w" liun_mb reob_mb '((8 . "OCG_AF_Koor_Kreuz")))) (load "chspace") (chspace Auswahl) (setq Auswahl (ssget "X" (list ( cons 8 "OCG_AF_Koor_Kreuz")))) (command "_explode" Auswahl) (command "modell" "") (command "löschen" (ssget "X" (list (cons 8 "OCG_AF_Koor_Kreuz")))"") (command "layout" "" "") ; ; Hinterlegung mit Farbe 255 Rechteck mit 8.375 Einheiten Abstand zeichnen Anfang (command "layer" "setzen" "OCG_AF_Koor_Hintergrund" "") (command "farbe" "vonlayer" "") (setq liun_af_xR (+ liun_af_x 8.375)) (setq reob_af_xR (- reob_af_x 8.375)) (setq liun_af_yR (+ liun_af_y 8.375)) (setq reob_af_yR (- reob_af_y 8.375)) (setq Rlu (list liun_af_xR liun_af_yR)) (setq Rro (list reob_af_xR reob_af_yR)) (command "rechteck" "b" 16 Rlu Rro "") ; Hinterlegung mit Farbe 255 Rechteck mit 8.375 Einheiten Abstand zeichnen Ende ; Rechteck mit 16.375 Einheiten Abstand zeichnen Anfang (command "layer" "setzen" "OCG_AF_Koor_Linie" "") (command "farbe" "vonlayer" "") (setq liun_af_xR (+ liun_af_x 16.375)) (setq reob_af_xR (- reob_af_x 16.375)) (setq liun_af_yR (+ liun_af_y 16.375)) (setq reob_af_yR (- reob_af_y 16.375)) (setq Rlu (list liun_af_xR liun_af_yR)) (setq Rro (list reob_af_xR reob_af_yR)) (command "rechteck" "b" 0.25 Rlu Rro "") (setq stutzkante_innen (entlast)) ;Rechteck_aussen Anfang (setq Rlu_a (list liun_af_x liun_af_y)) (setq Rro_a (list reob_af_x reob_af_y)) (command "rechteck" "b" 0.25 Rlu_a Rro_a "") (setq stutzkante_aussen (entlast)) (setq Rlu_a (list (- liun_af_x 5) (- liun_af_y 5))) ;Rechteck_aussen Ende ;;;;********************* von MH eingefügt***************************Ende ; ; jetzt gehts richtig los ;*************************** X-Werte ***************************Anfang ; unterer Rand, x werte ; (setq delta_m (- reun_mb_x liun_mb_x)) ; dargestellte Koord.diff im Modellb. (setq delta_a (- reun_af_x liun_af_x)) ; dargestellte Koord.diff im Ansichtsf. (setq cy_af liun_af_y) (if (and (> alpha (/ pi 2.)) (< alpha (* 3 (/ pi 2.)))) ; Richtg. der Linie in Abh. von Drehung MB in AF (setq richtg (- alpha (/ pi 2.))) (setq richtg (+ alpha (/ pi 2.))) ) ; end if (if (< richtg 0) (setq richtg (+ richtg pi pi))) ; nur Richtung 0 .. 2pi zulaessig (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi))) (setq textht 2) (if (< richtg (/ pi 2)) ; Textrichtg. in Abh. von Linienrichtg. (progn (setq textri (/ (* richtg 180 ) pi)) (setq textausri (if lraussen "mr" "ml")) ) ; end progn (progn (setq textri (/ (* (- richtg pi) 180 ) pi)) (setq textausri (if lraussen "ml" "mr")) ) ; end progn ) ; end if (if lraussen (setq richtg (+ richtg pi))) (setq cx_mb startx) (setq minx (min liun_mb_x reun_mb_x)) ; es kann auch in negativer Richtung verlaufen (setq maxx (max liun_mb_x reun_mb_x)) (while (<= cx_mb minx) ; ersten auf Rand im MB vorh. Wert ermitteln (setq cx_mb (+ cx_mb delta_l)) ) ; end while cx_mb (while (< cx_mb maxx) (setq delta_m1 (- cx_mb liun_mb_x)) ; Streckenverhaeltnisse (setq cx_af (+ liun_af_x (* (/ delta_m1 delta_m) delta_a))) (setq ctext (rtos cx_mb 2 0)) (setq p1 (list cx_af cy_af)) (setq p2 (polar p1 richtg 5)) (setq pt (polar p1 richtg 6)) (command "layer" "setzen" "OCG_AF_Koor_Linie_X" "") ;von MH eingefügt (command "linie" p1 p2 "") (command "layer" "setzen" "OCG_AF_Koor_Text_X" "") ;von MH eingefügt (command "text" "p" textausri pt textht textri ctext) (setq cx_mb (+ cx_mb delta_l)) ) ; end while cx_mb ; oberer Rand, x werte ; (setq delta_m (- reob_mb_x liob_mb_x)) (setq delta_a (- reob_af_x liob_af_x)) (setq cy_af liob_af_y) (if (and (> alpha (/ pi 2.)) (< alpha (* 3 (/ pi 2.)))) (setq richtg (+ alpha (/ pi 2.))) (setq richtg (- alpha (/ pi 2.))) ) ; end if (if (< richtg 0) (setq richtg (+ richtg pi pi))) (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi))) (setq textht 2) (if (< richtg (* pi 1.5)) (progn (setq textri (/ (* (- richtg pi) 180 ) pi)) (setq textausri (if lraussen "ml" "mr")) ) ; end progn (progn (setq textri (/ (* richtg 180 ) pi)) (setq textausri (if lraussen "mr" "ml")) ) ; end progn ) ; end if (if lraussen (setq richtg (+ richtg pi))) (setq cx_mb startx) (setq minx (min liob_mb_x reob_mb_x)) (setq maxx (max liob_mb_x reob_mb_x)) (while (<= cx_mb minx) (setq cx_mb (+ cx_mb delta_l)) ) ; end while cx_mb (while (< cx_mb maxx) (setq delta_m1 (- cx_mb liob_mb_x)) (setq cx_af (+ liob_af_x (* (/ delta_m1 delta_m) delta_a))) (setq ctext (rtos cx_mb 2 0)) (setq p1 (list cx_af cy_af)) (setq p2 (polar p1 richtg 5)) (setq pt (polar p1 richtg 6)) (command "layer" "setzen" "OCG_AF_Koor_Linie_X" "") ;von MH eingefügt (command "linie" p1 p2 "") (command "layer" "setzen" "OCG_AF_Koor_Text_X" "") ;von MH eingefügt (command "text" "p" textausri pt textht textri ctext) (setq cx_mb (+ cx_mb delta_l)) ) ; end while cx_mb ; linker Rand, x werte ; (setq delta_m (- liob_mb_x liun_mb_x)) (setq delta_a (- liob_af_y liun_af_y)) (setq cx_af liun_af_x) (if (> alpha pi) (setq richtg (+ alpha (/ pi 2.))) (setq richtg (- alpha (/ pi 2.))) ) ; end if (if (< richtg 0) (setq richtg (+ richtg pi pi))) (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi))) (setq textht 2) (setq textri (/ (* richtg 180 ) pi)) ; (setq textausri "ml") (setq textausri (if lraussen "mr" "ml")) (if lraussen (setq richtg (+ richtg pi))) (setq cx_mb startx) (setq minx (min liob_mb_x liun_mb_x)) (setq maxx (max liob_mb_x liun_mb_x)) (while (<= cx_mb minx) (setq cx_mb (+ cx_mb delta_l)) ) ; end while cx_mb (while (< cx_mb maxx) (setq delta_m1 (- cx_mb liun_mb_x)) (setq cy_af (+ liun_af_y (* (/ delta_m1 delta_m) delta_a))) (setq ctext (rtos cx_mb 2 0)) (setq p1 (list cx_af cy_af)) (setq p2 (polar p1 richtg 5)) (setq pt (polar p1 richtg 6)) (command "layer" "setzen" "OCG_AF_Koor_Linie_X" "") ;von MH eingefügt (command "linie" p1 p2 "") (command "layer" "setzen" "OCG_AF_Koor_Text_X" "") ;von MH eingefügt (command "text" "p" textausri pt textht textri ctext) (setq cx_mb (+ cx_mb delta_l)) ) ; end while cx_mb ; rechter Rand, x werte ; (setq delta_m (- reob_mb_x reun_mb_x)) (setq delta_a (- reob_af_y reun_af_y)) (setq cx_af reun_af_x) (if (< alpha pi) (setq richtg (+ alpha (/ pi 2.))) (setq richtg (- alpha (/ pi 2.))) ) ; end if (if (< richtg 0) (setq richtg (+ richtg pi pi))) (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi))) (setq textht 2) (setq textri (/ (* (- richtg pi) 180 ) pi)) (setq textausri (if lraussen "ml" "mr")) (if lraussen (setq richtg (+ richtg pi))) (setq cx_mb startx) (setq minx (min reob_mb_x reun_mb_x)) (setq maxx (max reob_mb_x reun_mb_x)) (while (<= cx_mb minx) (setq cx_mb (+ cx_mb delta_l)) ) ; end while cx_mb (while (< cx_mb maxx) (setq delta_m1 (- cx_mb reun_mb_x)) (setq cy_af (+ reun_af_y (* (/ delta_m1 delta_m) delta_a))) (setq ctext (rtos cx_mb 2 0)) (setq p1 (list cx_af cy_af)) (setq p2 (polar p1 richtg 5)) (setq pt (polar p1 richtg 6)) (command "layer" "setzen" "OCG_AF_Koor_Linie_X" "") ;von MH eingefügt (command "linie" p1 p2 "") (command "layer" "setzen" "OCG_AF_Koor_Text_X" "") ;von MH eingefügt (command "text" "p" textausri pt textht textri ctext) (setq cx_mb (+ cx_mb delta_l)) ) ; end while cx_mb ;**************************** X-Werte ***************************Ende ;*************************** Y-Werte ***************************Anfang ; linker Rand, y werte ; (setq delta_m (- liob_mb_y liun_mb_y)) (setq delta_a (- liob_af_y liun_af_y)) (setq cx_af liun_af_x) (if (and (> alpha (/ pi 2.)) (< alpha (* 3 (/ pi 2.)))) (setq richtg (+ pi alpha)) (setq richtg (+ alpha)) ) ; end if (if (< richtg 0) (setq richtg (+ richtg pi pi))) (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi))) (setq textht 2) (setq textausri (if lraussen "mr" "ml")) (setq textri (/ (* richtg 180 ) pi)) (if lraussen (setq richtg (+ richtg pi))) (setq cy_mb starty) (setq miny (min liob_mb_y liun_mb_y)) (setq maxy (max liob_mb_y liun_mb_y)) (while (<= cy_mb miny) (setq cy_mb (+ cy_mb delta_l)) ) ; end while cy_mb (while (< cy_mb maxy) (setq delta_m1 (- cy_mb liun_mb_y)) (setq cy_af (+ liun_af_y (* (/ delta_m1 delta_m) delta_a))) (setq ctext (rtos cy_mb 2 0)) (setq p1 (list cx_af cy_af)) (setq p2 (polar p1 richtg 5)) (setq pt (polar p1 richtg 6)) (command "layer" "setzen" "OCG_AF_Koor_Linie_Y" "") ;von MH eingefügt (command "linie" p1 p2 "") (command "layer" "setzen" "OCG_AF_Koor_Text_Y" "") ;von MH eingefügt (command "text" "p" textausri pt textht textri ctext) (setq cy_mb (+ cy_mb delta_l)) ) ; end while cy_mb ; rechter Rand, y werte ; (setq delta_m (- reob_mb_y reun_mb_y)) (setq delta_a (- reob_af_y reun_af_y)) (setq cx_af reun_af_x) (if (and (> alpha (/ pi 2.)) (< alpha (* 3 (/ pi 2.)))) (setq richtg (+ alpha)) (setq richtg (+ pi alpha)) ) ; end if (if (< richtg 0) (setq richtg (+ richtg pi pi))) (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi))) (setq textht 2) (setq textri (/ (* (- richtg pi) 180 ) pi)) (setq textausri (if lraussen "ml" "mr")) (if lraussen (setq richtg (+ richtg pi))) (setq cy_mb starty) (setq miny (min reun_mb_y reob_mb_y)) (setq maxy (max reun_mb_y reob_mb_y)) (while (<= cy_mb miny) (setq cy_mb (+ cy_mb delta_l)) ) ; end while cy_mb (while (< cy_mb maxy) (setq delta_m1 (- cy_mb reun_mb_y)) (setq cy_af (+ reun_af_y (* (/ delta_m1 delta_m) delta_a))) (setq ctext (rtos cy_mb 2 0)) (setq p1 (list cx_af cy_af)) (setq p2 (polar p1 richtg 5)) (setq pt (polar p1 richtg 6)) (command "layer" "setzen" "OCG_AF_Koor_Linie_Y" "") ;von MH eingefügt (command "linie" p1 p2 "") (command "layer" "setzen" "OCG_AF_Koor_Text_Y" "") ;von MH eingefügt (command "text" "p" textausri pt textht textri ctext) (setq cy_mb (+ cy_mb delta_l)) ) ; end while cy_mb ; unterer Rand, y werte ; (setq delta_m (- reun_mb_y liun_mb_y)) (setq delta_a (- reun_af_x liun_af_x)) (setq cy_af liun_af_y) (if (< alpha pi) (setq richtg (+ alpha)) (setq richtg (+ pi alpha)) ) ; end if (if (< richtg 0) (setq richtg (+ richtg pi pi))) (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi))) (setq textht 2) (if (< richtg (/ pi 2)) (progn (setq textri (/ (* richtg 180 ) pi)) (setq textausri (if lraussen "mr" "ml")) ) ; end progn (progn (setq textri (/ (* (- richtg pi) 180 ) pi)) (setq textausri (if lraussen "ml" "mr")) ) ; end progn ) ; end if (if lraussen (setq richtg (+ richtg pi))) (setq cy_mb starty) (setq miny (min liun_mb_y reun_mb_y)) (setq maxy (max liun_mb_y reun_mb_y)) (while (<= cy_mb miny) (setq cy_mb (+ cy_mb delta_l)) ) ; end while cy_mb (while (< cy_mb maxy) (setq delta_m1 (- cy_mb liun_mb_y)) (setq cx_af (+ liun_af_x (* (/ delta_m1 delta_m) delta_a))) (setq ctext (rtos cy_mb 2 0)) (setq p1 (list cx_af cy_af)) (setq p2 (polar p1 richtg 5)) (setq pt (polar p1 richtg 6)) (command "layer" "setzen" "OCG_AF_Koor_Linie_Y" "") ;von MH eingefügt (command "linie" p1 p2 "") (command "layer" "setzen" "OCG_AF_Koor_Text_Y" "") ;von MH eingefügt (command "text" "p" textausri pt textht textri ctext) (setq cy_mb (+ cy_mb delta_l)) ) ; end while cy_mb ; oberer Rand, y werte ; (setq delta_m (- reob_mb_y liob_mb_y)) (setq delta_a (- reob_af_x liob_af_x)) (setq cy_af liob_af_y) (if (< alpha pi) (setq richtg (+ pi alpha)) (setq richtg (+ alpha)) ) ; end if (if (< richtg 0) (setq richtg (+ richtg pi pi))) (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi))) (setq textht 2) (if (< richtg (* pi 1.5)) (progn (setq textri (/ (* (- richtg pi) 180 ) pi)) (setq textausri (if lraussen "ml" "mr")) ) ; end progn (progn (setq textri (/ (* richtg 180 ) pi)) (setq textausri (if lraussen "mr" "ml")) ) ; end progn ) ; end if (if lraussen (setq richtg (+ richtg pi))) (setq cy_mb starty) (setq miny (min liob_mb_y reob_mb_y)) (setq maxy (max liob_mb_y reob_mb_y)) (while (<= cy_mb miny) (setq cy_mb (+ cy_mb delta_l)) ) ; end while cy_mb (while (< cy_mb maxy) (setq delta_m1 (- cy_mb liob_mb_y)) (setq cx_af (+ liob_af_x (* (/ delta_m1 delta_m) delta_a))) (setq ctext (rtos cy_mb 2 0)) (setq p1 (list cx_af cy_af)) (setq p2 (polar p1 richtg 5)) (setq pt (polar p1 richtg 6)) (command "layer" "setzen" "OCG_AF_Koor_Linie_Y" "") ;von MH eingefügt (command "linie" p1 p2 "") (command "layer" "setzen" "OCG_AF_Koor_Text_Y" "") ;von MH eingefügt (command "text" "p" textausri pt textht textri ctext) ;***************************** Y-Werte ***************************Ende (setq cy_mb (+ cy_mb delta_l)) ) ; end while cy_mb ) ;end progn ) ; end if viewport (setq x (1+ x)) ) ;;;;********************* von MH eingefügt***************************Anfang ; ; ; Einragende Linien im inneren Rechteck stutzen ANFANG ; ; (command "zoom" "Objekt" stutzkante_innen "") ; (setq liun_af_xRi (+ liun_af_xR 2)) ; (setq reob_af_xRi (- reob_af_xR 2)) ; (setq liun_af_yRi (+ liun_af_yR 2)) ; (setq reob_af_yRi (- reob_af_yR 2)) ; (setq Rlui (list liun_af_xRi liun_af_yRi)) ; (setq Rroi (list reob_af_xRi reob_af_yRi)) ; (etrim stutzkante_innen Rroi) ; ; Einragende Linien im inneren Rechteck stutzen Ende ; ; ; Ausragende Linien an Ansichtsfenster "Rechteck" stutzen Anfang ; (command "zoom" "Objekt" stutzkante_aussen "") ; (etrim stutzkante_aussen Rlu_a) ; (command "löschen" stutzkante_aussen "") ; (command "zoom" "alles" "") ; ; Ausragende Linien an Ansichtsfenster "Rechteck" stutzen Ende ; ;;;;********************* von MH eingefügt***************************Ende ; ; Ausgangsbedingungen wieder herstellen ; (setvar "blipmode" sblip) (setvar "cmdecho" scmde) (setvar "osmode" sosmode) (setvar "angbase" sangbase) (setvar "angdir" sangdir) (setvar "aunits" saunits) (setvar "autosnap" pkwsnap) ; von MH eingefügt (setvar "aperture" aperturewert) ; von MH eingefügt (setq *error* alterror) (prompt "Koordinaten gesetzt") (princ) )