Code:
;;; Ermittle befindlige Geländeprofil aus 2 gewählten Geländepunkten
;;; obj; Textobjekt
;;; bef_h; befindlige höhe zahlwert
;;; bef_p; befindlige höhe koordinate
;;; bef_list; Liste aus höhe und koordinate
(alert "\nEntnommene Höhenangaben liegen in einer Flucht! ")
(repeat 2
(while
(not
(and
(setq obj (car (entsel "\nWähle 2 Geländehöhen !")))
(not
(if (/= (cdr(assoc 0 (entget OBJ))) "TEXT")
(princ "\nkein Text gewählt")
)
)
(setq bef_h (atof (cdr (assoc 1 (entget obj)))) )
(setq bef_p (cdr (assoc 10 (entget obj))))
(setq bef_list (cons (cons bef_h bef_p) bef_list))
)
)
)
(princ)
)
;;; Ermittle Oberbau daten
;;; obj; Textobjekt
;;; ny_ob; neuer Oberbau Qneigung, breite, stärke
;;; ny_h; neue höhe oberkante asfalt oberbau
;;; ny_p; Mittelpunkt der neuen trasse
;;; ny_di; Strecke zw. terassenmitte und letzt angegeb.bef. Geländepunkt
;;; ny_dh; Höhenunterschied zw. terassemitte und letzt angegeb. bef. Geländepunkt
(while
(not
(and
(setq obj (car (entsel "\nWähle die neue Geländehöhe in der Trassenmitte !")))
(if (/= (cdr(assoc 0 (entget OBJ))) "TEXT")
(princ "\nkein Text gewählt")
(setq ny_ob (list (set 'a (/ (getreal "\nWert für Querneigung in [%] ") 100))
(set 'a (getreal "\nWert für Oberbau breite in [m] "))
(set 'a (getreal "\nWert für Oberbau stärke in [m] "))
)
)
)
(setq ny_h (atof (cdr (assoc 1 (entget obj)))))
(setq ny_p (cdr (assoc 10 (entget obj))))
(setq ny_di (distance (list (nth 0 bef_p) (nth 1 bef_p)) (list (nth 0 ny_p) (nth 1 ny_p))))
(setq ny_dh (- ny_h bef_h (nth 2 ny_ob)))
)
)
(princ)
)
;;; Erzeuge Geländeprofil mit Eintrag des neuen Strassenkörpers
;;; bef_di; Abstand der zwei gew. geländepunkte
;;; bef_dh; Höhenunterschied zw. den zwei geländepunkten
;;; bef_gf; resultierendes Gefälle
;;; ip; Einfügepunkt querschnitt
(progn
(cond
((= bef_list
(setq bef_di (distance (cdar bef_list) (cdadr bef_list)))
(setq bef_dh (- (caar bef_list) (caadr bef_list)))
(setq bef_gf (/ bef_dh bef_di))
(setq ip (getpoint "\nEinfügepunkt setzen! "))
)
)
)
)
(entmake (list (cons 0 "LINE") (cons 67 0) (cons 410 "Model") (cons 8 "0")
(setq bef_li (cons 10 (setq ip (list (+ 1 (nth 0 ip)) (+ 1 (nth 1 ip)) (nth 2 ip)))))
(setq bef_re (cons 11 (setq ip (list (+ (nth 0 ip) bef_di) (+ (* bef_di bef_gf) (nth 1 ip)) 0.0))))
)
)
;;; t_mi; Trassen mittelpunkt
;;; t_li; Trassen punkt links
;;; t_re; Trassen punkt rechts
(progn
(cond
((= ny_ob
(setq t_mi (list (- (nth 0 ip) ny_di)
(+ (nth 1 ip) ny_dh)
(nth 2 ip)
)
)
(setq t_li (list (- (nth 0 t_mi) (/ (nth 1 ny_ob) 2) (nth 2 ny_ob))
(+ (nth 1 t_mi) (* (nth 0 ny_ob) (+ (/ (nth 1 ny_ob) 2) (nth 2 ny_ob))))
(nth 2 ip)
)
)
(setq t_re (list (+ (nth 0 t_li) (+ (nth 1 ny_ob) (nth 2 ny_ob) (nth 2 ny_ob)))
(+ (nth 1 t_li) (* (nth 0 ny_ob) (+ (nth 1 ny_ob) (nth 2 ny_ob) (nth 2 ny_ob))))
(nth 2 ip)
)
)
)
)
)
)
(entmake (list (cons 0 "LINE") (cons 67 0) (cons 410 "Model") (cons 8 "0")
(cons 10 t_li) (cons 11 t_re)
)
)
;;; Ermittlung der Auf- und Abtragsflächen
;;; t_wi; Trassen querneigung
;;; t_li_s; Trassen böschungspunkt links
;;; t_re_s; Trassen böschungspunkt rechts
(if (not c:cal)(arxload "geomcal"))
(setq bef_li (cdr bef_li))
(setq bef_re (cdr bef_re))
(setq t_bef_s (inters t_li t_re bef_li bef_re))
(progn
(cond
;;; liegt Gelände links über der Trasse, dann Abtrag mit 4:1 Gefälle
((> (nth 1 bef_li) (nth 1 t_li))
(setq t_wi (+ (angle t_li t_re) (* 104.0362 (/ pi 180))))
(setq t_li_s (polar t_li t_wi 1.0))
(setq t_li_s (cal "ill (t_li,t_li_s,bef_li,bef_re)"))
)
;;; liegt Gelände links unter der Trasse, dann Auftrag mit 1:1 Gefälle
((< (nth 1 bef_li) (nth 1 t_li))
(setq t_wi (+ (angle t_li t_re) (* 225.0 (/ pi 180))))
(setq t_li_s (polar t_li t_wi 1.0))
(setq t_li_s (cal "ill (t_li,t_li_s,bef_li,bef_re)"))
)
)
)
(progn
(cond
;;; liegt Gelände rechts über der Trasse, dann Abtrag mit 4:1 Gefälle
((> (nth 1 bef_re) (nth 1 t_re))
(setq t_wi (+ (angle t_li t_re) (* 75.9638 (/ pi 180))))
(setq t_re_s (polar t_re t_wi 1.0))
(setq t_re_s (cal "ill (t_re,t_re_s,bef_li,bef_re)"))
)
;;; liegt Gelände rechts unter der Trasse, dann Aufrag mit 1:1 Gefälle
((< (nth 1 bef_re) (nth 1 t_li))
(setq t_wi (+ (angle t_li t_re) (* 135.0 (/ pi 180))))
(setq t_re_s (polar t_re t_wi 1.0))
(setq t_re_s (cal "ill (t_re,t_re_s,bef_li,bef_re)"))
)
)
)
(entmake (list (cons 0 "LINE") (cons 67 0) (cons 410 "Model") (cons 8 "0")
(cons 10 t_li) (cons 11 t_li_s)
)
)
(entmake (list (cons 0 "LINE") (cons 67 0) (cons 410 "Model") (cons 8 "0")
(cons 10 t_re) (cons 11 t_re_s)
)
)
;;; Berechnung der Auf- und Abtragsflächen
(progn
(cond
;;; wenn die Trasse links unter dem Gelände liegt
((< (nth 1 t_li) (nth 1 t_li_s))
(cond
((> (nth 1 t_re) (nth 1 t_re_s))
(command "_pline" t_bef_s t_li t_li_s "_c" "")
(command "_area" "_o" (entlast))
(setq fl_ab (getvar "area"))
)
)
(command "_pline" t_bef_s t_re t_re_s "_c" "")
(command "_area" "_o" (entlast))
(setq fl_au (getvar "area"))
)
;;; wenn die Trasse rechts unter dem Gelände liegt
((< (nth 1 t_re) (nth 1 t_re_s))
(cond
((< (nth 1 t_re) (nth 1 t_re_s))
(command "_pline" t_bef_s t_re t_re_s "_c" "")
(command "_area" "_o" (entlast))
(setq fl_ab (getvar "area"))
)
)
(command "_pline" t_li_s t_bef_s t_li "_c" "")
(command "_area" "_o" (entlast))
(setq fl_au (getvar "area"))
)
;;; wenn die Trasse über dem Gelände liegt
((> (nth 1 t_li) (nth 1 t_li_s))
(cond
((> (nth 1 t_re) (nth 1 t_re_s))
(command "_pline" t_li_s t_li t_re t_re_s "_c" "")
(command "_area" "_o" (entlast))
(setq fl_au (getvar "area"))
)
)
)
)
)