;------------------------------------------------------------------------------------------------------------------------------------- ; ; Schnittstelle zu anderen Modulen: ; ; INPUT und INPUTRESTRIKTIONEN ; ============================ ; ; Parameter : ; ; Typ Variablename Variablebeschreibung [Wertebereich] ; list lzentup Zentrum Kreis(bogen) ; real rradiusup Radius Kreis(bogen) ; list lspktup Startpunkt Linie ; list lepktup Endpunkt Linie ; ; OUTPUT und OUTPUTRESTRIKTIONEN ; ============================== ; ; Parameter : ; ; Typ Variablenname Variablenbeschreibung [Wertebereich] ; list lschnpkte Schnittpunkte ; ;------------------------------------------------------------------------------------------------------------------------------------------------------------------------- ; ( defun schnpkt_kreis_linie ( lzentup rradiusup lspktup lepktup / ikst lepkt lepktbrg linters lschnpkt1 lschnpkt2 lschnpkte lsenkwaagbrg lspkt lspktbrg lzent lzentbrg rabst rb rd rm rradius rradiusa rwingerade rwinkelbm rwinrot1 rwinrot2 rwinsepkt rx1 rx2 ry1 ry2 srot ssenk ) ; Die Übergabevariablen in lokale Variablen übernehmen (setq lzent lzentup) (setq rradius rradiusup) (setq lspkt lspktup) (setq lepkt lepktup) ; Die Punkte der Linie entsprechend dem Zentrum (0.0 0.0 0.0) berechnen (setq rwingerade 90.0) (setq rradiusa (abs rradius)) (setq lzentbrg (list 0.0 0.0 0.0)) (setq lsenkwaagbrg (polar lzentbrg (wingrbm rwingerade) (* rradiusa 2))) ; Senkrechte (setq rabst (distance lzent lzentbrg)) (setq rwinkelbm (angle lzent lzentbrg)) (setq lspktbrg (polar lspkt rwinkelbm rabst)) (setq lepktbrg (polar lepkt rwinkelbm rabst)) (setq rwinsepkt (atof (angtos (angle lspktbrg lepktbrg)))) (if (or (= rwinsepkt rwingerade) (= rwinsepkt (+ rwingerade 180.0))) (progn (setq ssenk nil) (setq lsenkwaagbrg (polar lzentbrg (wingrbm (+ rwingerade rwingerade)) (* rradiusa 2))) ; Waagrechte ) ; progn (progn (setq ssenk t) ) ; progn ) ; if ; Bei senkrechter Linie das Koordinatenwsystem um 90° drehen ; (abgeleitet vom Beitrag http://ww3.cad.de/foren/ubb/Forum145/HTML/004173.shtml#000010) (setq srot nil) (setq rwinrot1 (atof (angtos (/ pi 2.0)))) (setq rwinrot2 (atof (angtos (+ pi (wingrbm rwinrot1))))) (setq ikst (getvar "luprec")) ; Anzahl Kommastellen (if (or (equal (angle lspktbrg lepktbrg) (wingrbm rwinrot1) (kommastellen_fuzzy ikst)) (equal (angle lspktbrg lepktbrg) (wingrbm rwinrot2) (kommastellen_fuzzy ikst))) (progn (setq lspktbrg (rotateWCS->UCS (car lspktbrg) (cadr lspktbrg) (wingrbm rwinrot1))) (setq lepktbrg (rotateWCS->UCS (car lepktbrg) (cadr lepktbrg) (wingrbm rwinrot1))) (setq lsenkwaagbrg (rotateWCS->UCS (car lsenkwaagbrg) (cadr lsenkwaagbrg) (wingrbm rwinrot1))) (setq srot t) (setq ssenk t) ) ; progn ) ; if ; Den Schnittpunkt für das Zentrum (0.0 0.0 0.0) berechnen ; (abgeleitet vom Beitrag http://ww3.cad.de/foren/ubb/Forum145/HTML/003455.shtml#000010) (setq lschnpkt1 nil) (setq lschnpkt2 nil) (setq linters (inters lspktbrg lepktbrg lzentbrg lsenkwaagbrg nil)) (if (/= linters nil) (progn (setq rb (cadr linters)) (if (= ssenk nil) (setq rm (/ (- (car lepktbrg) (car lspktbrg)) (- (cadr lepktbrg) (cadr lspktbrg)))) (setq rm (/ (- (cadr lepktbrg) (cadr lspktbrg)) (- (car lepktbrg) (car lspktbrg)))) ; else ) ; if ; Diskriminante rd = rradiusa² * (1 + rm²) - rb² ; rd>0 -> Kreis wird in zwei Punkten geschnitten ; rd=0 -> Kreis wird in einem Punkten berührt ; rd<0 -> Kreis wird von Gerade gemieden (setq rd (- (* (* rradiusa rradiusa) (1+ (* rm rm))) (* rb rb))) (if (equal rd 0.0 (kommastellen_fuzzy ikst)) (setq rd 0.0) ) ; if (if (>= rd 0.0) (progn ; Die Schnittpunkte berechnen (setq rx1 (/ (+ (* -1 rm rb) (sqrt rd)) (1+ (* rm rm)))) (setq rx2 (/ (- (* -1 rm rb) (sqrt rd)) (1+ (* rm rm)))) (setq ry1 (/ (+ rb (* rm (sqrt rd))) (1+ (* rm rm)))) (setq ry2 (/ (- rb (* rm (sqrt rd))) (1+ (* rm rm)))) (setq lschnpkt1 (list rx1 ry1 0.0)) (setq lschnpkt2 (list rx2 ry2 0.0)) ; Das Koordinatenwsystem gegebenenfalls zurückdrehen ; (abgeleitet vom Beitrag http://ww3.cad.de/foren/ubb/Forum145/HTML/004173.shtml#000010) (if (/= srot nil) (progn (setq lschnpkt1 (rotateUCS->WCS (car lschnpkt1) (cadr lschnpkt1) (wingrbm rwinrot1))) (setq lschnpkt2 (rotateUCS->WCS (car lschnpkt2) (cadr lschnpkt2) (wingrbm rwinrot1))) ) ; progn ) ; if ) ; progn ) ; if ) ; progn ) ; if ; Den Schnittpunkt gegebenenfalls für das tatsächliche Zentrum berechnen (if (/= lschnpkt1 nil) (progn (setq rabst (distance lzentbrg lzent)) (setq rwinkelbm (angle lzentbrg lzent)) (setq lschnpkt1 (polar lschnpkt1 rwinkelbm rabst)) ) ; progn ) ; if (if (/= lschnpkt2 nil) (progn (setq rabst (distance lzentbrg lzent)) (setq rwinkelbm (angle lzentbrg lzent)) (setq lschnpkt2 (polar lschnpkt2 rwinkelbm rabst)) ) ; progn ) ; if ; Den Rückgabewert ermitteln (setq lschnpkte nil) (setq lschnpkte (append lschnpkte (list lschnpkt1))) (setq lschnpkte (append lschnpkte (list lschnpkt2))) ; Rückgabewert lschnpkte ) ; Modulende