;;;**********************************************************
;;; ROHR4.lsp  /getestet mit AutoCAD 2002
;;; Stand: 13.03.2003
;;; eduaotto@gmx.de
;;; Programm: C:ROHR
;;; Beschreibung: Rohrleitung mit/ohne Isolationslinien zeichnen.
;;;               Erweiterung des Programms 2LINE von Craig Allen.
;;;
;;;---------------------------------------------------------s|
(defun rohr_info ( DN / )
  (if (/= DN "")
    (princ (strcat "\nGesetzter DN-Wert: " DN))
  )
  (if (> *#iso_offset 0)
    (princ (strcat "\n   Abstand der Isolationslinien vom Rohr: "
                   (rtos *#iso_offset)
           ) ;_ strcat
    ) ;_ princ
    (princ "\n   Keine Isolationslinien")
  ) ;_ if
)
;;;---------------------------------------------------------|
(defun arc_s_e ( ent / c e r s )
  ;;Bogenendpunkte und Startpunkt ermitteln
  (setq ent (entget ent))
  (setq c (dxf 10 ent)                  ;the center point
        r (dxf 40 ent)                  ;the radius
        s (dxf 50 ent)                  ;the start angle
        e (dxf 51 ent)                  ;the end angle
  )                                     ;setq
  (setq s (polar c s r))
  (setq e (polar c e r))
  (list c s e)
) ;_ defun
;;;------- Subs für PIPE BREAK SYMBOL senkrecht z. Ze. -----|
;;;convert radians to current system unit for angles
(defun rtu ( x )
  (if
    (or
      (= 0 (getvar "AUNITS"))
      (= 1 (getvar "AUNITS"))
      (= 4 (getvar "AUNITS"))
    ) ;_ or
     (setq x (/ (* x 180.0) pi))
  ) ;_ if
  (if (= 2 (getvar "AUNITS"))
    (setq x (/ (* x 200.0) pi))
  ) ;_ if
  ;;return converted angle
  x
) ;_ defun

;;polar to rectangular
(defun p2r ( pol )
  (list
    (* (car pol) (cos (cadr pol)))
    (* (car pol) (sin (cadr pol)))
  ) ;_ list
) ;_ defun

;;rectangular to polar
(defun r2p ( / )
  (list
    (sqrt
      (+
        (* (car 2dpt) (car 2dpt))
        (* (cadr 2dpt) (cadr 2dpt))
      ) ;_ +
    ) ;_ sqrt
    (atan (cadr 2dpt) (car 2dpt))
  ) ;_ list
) ;_ defun

;;defines ellipse points
(defun ept ( x )
  (list
    x
    (sqrt (* (* b b) (- 1.0 (/ (* x x) (* a a)))))
  ) ;_ list
) ;_ defun

;;;---------------- PIPE BREAK SYMBOL senkrecht z. Ze. -----|
;;command shows the symbol for a pipe running perpendicular
;;to the drawing plane
;;modified version, original by Stan Kowalski
(defun C:SSS ( / a angle_ ANS axis_dist axis_pt b cen_pt cmd CPT
                C_BLIP E1 echo ENT factor FLY HPI HR index os P1 P2 P3
                P4 P5 paxis_pt pol PT1 PT2 PT3 PT4 pts pts1 QPI R RAD
                SS1 UPT1 YO YO2
             )

  (command "_undo" "_begin")
  (setq cmd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq
    E1 (car
         (entsel "\nBogen, Ellipse oder Kreis am Rohrende picken: ")
       ) ;_ car
  ) ;_ setq
  (if E1
    (progn
      (setq E1 (entget E1))             ;entity data list
      (if (or (= (cdr (assoc '0 E1)) "ELLIPSE")
              (= (cdr (assoc '0 E1)) "ARC")
              (= (cdr (assoc '0 E1)) "CIRCLE")
          ) ;_ or
        (progn
          (if (or (= (cdr (assoc '0 E1)) "ARC")
                  (= (cdr (assoc '0 E1)) "CIRCLE")
              ) ;_ or
            (progn
              (setq P1 (cdr (assoc 10 E1))) ;start of circle
              (setq R (cdr (assoc 40 E1))) ;circle radius
              (setq HPI (/ PI 2.0))     ;half value of PI
              (setq QPI (/ PI 4.0))     ;quarter value of PI
              (setq HR (/ r 2.0))       ;half value of radius
              (setq P2 (polar P1 HPI R)) ;upper end
              (setq P3 (polar P1 HPI HR)) ;half way between points
              (setq P3 (polar P3 PI (* -1 HR))) ;over half radius, <- HR
              (setq P4 (polar P1 (+ PI HPI) R)) ;lower end
              (setq P5 (polar P1 (+ PI HPI) HR))
                                        ;half way between points
              (setq P5 (polar p5 PI HR)) ;over half radius, <- 0.0
              (setvar "blipmode" 0)
              (command "_pline" P2 "_arc" "_s" P3 P1 "_s" P5 P4 "")
              (setq ANS nil)
              (setq ANS
                     (strcase
                       (getstring "\nHalbes Symbol schraffieren <j/N>? ")
                     ) ;_ strcase
              ) ;_ setq
              (if (= ANS "J")
                (progn
                  (command "_pline"      P2     "_arc" "_ce"  P1
                           P4     "_s"   P5     P1     "_s"   P3
                           P2     ""
                          ) ;_ command
                  (command "_hatch" "_u" 45 (/ R 12.0) "_n" "_l" "")
                  (command "_erase" "_p" "")
                ) ;_ progn
              ) ;_ if
            ) ;_ progn
            (progn
              (setq ent E1)
              (command "_undo" "_begin")
              (cond
                ((= (cdr (assoc 0 ent)) "ELLIPSE")
                 (setq cpt  (cdr (assoc 10 ent))
                       upt1 (cdr (assoc 11 ent))
                       rad  (cdr (assoc 40 ent))
                 ) ;_ setq
                 (setq upt1 (list (+ (car cpt) (car upt1))
                                  (+ (cadr cpt) (cadr upt1))
                                  (+ (caddr cpt) (caddr upt1))
                            ) ;_ list
                       rad  (* (distance cpt upt1) rad)

                 ) ;_ setq
                 (setq pt1 (polar cpt
                                  (angle cpt upt1)
                                  (distance cpt upt1)
                           ) ;_ polar
                       pt2 (polar cpt
                                  (angle upt1 cpt)
                                  (distance cpt upt1)
                           ) ;_ polar
                       pt3 (polar cpt
                                  (+ (angle cpt upt1) (/ pi 2.0))
                                  rad
                           ) ;_ polar
                       pt4 (polar cpt
                                  (+ (angle upt1 cpt) (/ pi 2.0))
                                  rad
                           ) ;_ polar
                 ) ;_ setq
                 (setq P1 cpt)
                 (setq P2 pt3)
                 (setq P3 (polar pt3 (angle pt3 pt4) (/ rad 4)))
                 (setq P3 (polar P3 (angle pt2 pt1) (/ rad 2)))
                 (setq P4 pt4)
                 (setq P5 (polar cpt (angle pt3 pt4) (/ rad 2)))
                 (setq P5 (polar P5 (angle pt1 pt2) (/ rad 2)))
                 (setq ss1 (ssadd))
                 (command "_pline" p2 "_arc" "_s" p3 p1 "_s" p5 p4 "")
                 (ssadd (entlast) ss1)

                 ;;###################################################
                 (setq ANS nil)
                 (setq ANS
                        (strcase
                          (getstring "\nHalbes Symbol schraffieren <j/N>? ")
                        ) ;_ strcase
                 ) ;_ setq
                 (if (= ANS "J")
                   (progn
                     (command "_pline" p2 "_arc" "_s" p3 p1 "_s" p5 p4
                              "") ;_ command
                     (setq cen_pt cpt)
                     (setq axis_pt pt4)
                     (setq axis_dist (distance cpt pt1))
                     (setq
                       axis_pt
                        (list
                          (- (car axis_pt) (car cen_pt))
                          (- (cadr axis_pt) (cadr cen_pt))
                        ) ;_ list
                     ) ;_ setq
                     (setq a (car (setq paxis_pt (r2p axis_pt))))
                     (setq b axis_dist)
                     (setq angle_ (cadr paxis_pt))
                     (setq factor 10)
                     (setq pts nil)
                     (setq index 0)
                     (while
                       (<= index factor)
                        (setq pts
                               (append
                                 pts
                                 (list
                                   (ept
                                     (* a (/ (float index) (float factor)))
                                   ) ;_ ept
                                 ) ;_ list
                               ) ;_ append
                        ) ;_ setq
                        (setq index (1+ index))
                     ) ;_ while
                                        ;mirror points
                     (setq pts1 nil)
                     (foreach
                               pt
                                 (cdr pts)
                       (setq pts1
                              (append
                                pts1
                                (list
                                  (list (* -1.0 (car pt)) (cadr pt))
                                ) ;_ list
                              ) ;_ append
                       ) ;_ setq
                     ) ;_ foreach

                                        ;combine lists of points
                     (setq
                       pts
                        (append
                          (reverse pts1)
                          pts
                        ) ;_ append
                     ) ;_ setq

                                        ;rotate points
                     (setq pts1 nil)
                     (foreach
                               pt
                                 pts
                       (setq pol (r2p pt))
                       (setq pol
                              (list
                                (car pol)
                                (+ (cadr pol) angle_)
                              ) ;_ list
                       ) ;_ setq

                       (setq pts1
                              (append
                                pts1
                                (list (p2r pol))
                              ) ;_ append
                       ) ;_ setq
                     ) ;_ foreach

                                        ;move points
                     (setq pts nil)
                     (foreach
                               pt
                                 pts1
                       (setq pts
                              (append
                                pts
                                (list (mapcar (quote +) cen_pt pt))
                              ) ;_ append
                       ) ;_ setq
                     ) ;_ foreach

                     (command)
                     (command "_.PLINE")
                     (foreach
                               pt
                                 pts
                       (command pt)
                     ) ;_ foreach
                     (command "")

                     (command "_.PEDIT" "_L" "_F" "_X")

                     (ssadd (entlast) ss1)
                     (setq yo (ssname ss1 0))
                     (setq yo2 (entget yo))

                     (if (OR (equal (cdr (assoc 0 yo2)) "POLYLINE")
                             (equal (cdr (assoc 0 yo2)) "LWPOLYLINE")
                         ) ;_ OR
                       (command "_pedit" yo "_j" ss1 "" "_x")
                       (command "_pedit" yo "_y" "_j" ss1 "" "_x")
                     ) ;_ if
                     (command "_hatch"
                              "_u"
                              45
                              (/ RAD 12.0)
                              "_n"
                              "_l"
                              ""
                     ) ;_ command
                     (command "_erase" "_p" "")
                   ) ;_ progn
                 ) ;_ cond
                ) ;_ while
              ) ;_ cond
              (command "_undo" "_end")
              ;;(setq ent (car (entsel)))
              ;;) ;_ while
            ) ;_ progn
          ) ;_ if
        )                               ;end prog
        (prompt "\nFalsches Objekt")
      )                                 ;end if
    )                                   ;end progn
    (prompt "\nNichts gewählt.")
  )                                     ;end if
  (command "_undo" "_end")
  (setvar "cmdecho" cmd)
  (setvar "osmode" os)
  (princ)
)                                       ;end of command
;;;---------------- PIPE BREAK SYMBOL parallel z. Ze. ------|
;;THIS IS TO DRAW A PIPE BREAK SYMBOL (LOOKS LIKE AN "8") AT THE END OF
;;A PAIR OF PARALLEL LINES.  POINTS SHOULD BE PICKED IN COUNTERCLOCKWISE
;;ORDER--IF AT THE RIGHT END OF PIPE, PICK THE TOP END, THEN THE BOTTOM END
;;IF AT THE LEFT END OF PIPE, PICK THE BOTTOM END FIRST, THEN THE TOP END

(defun C:SSP ( / ans cm cmd os pb pm pt ss1 yo yo2 )
  (setq ss1 nil)
  (setq cmd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq os (getvar "osmode"))
  (setvar "osmode" 1)                   ;endpoint
  (setq pb (getpoint
             "\n1. Punkt am Rohr-Ende picken (gegen Uhrzeigersinn) "
           ) ;_ getpoint
  ) ;_ setq
  (if pb
    (progn
      (command "_undo" "_begin")
      (setq pt (getpoint "\n2. Punkt picken "))
      (terpri)
      (if pt
        (progn
          (setvar "osmode" 0)           ;none
          (setq SS1 (ssadd))
          (setq pm (polar pb (angle pb pt) (/ (distance pb pt) 2)))
          (command "_arc"
                   pb
                   "_e"
                   pm
                   "_r"
                   (- (distance pb pm) (/ (distance pb pm) 2.75))
          ) ;_ command
          (ssadd (entlast) ss1)
          (command "_arc"
                   pm
                   "_e"
                   pt
                   "_r"
                   (- (distance pb pm) (/ (distance pb pm) 2.75))
          ) ;_ command
          (ssadd (entlast) ss1)
          ;;(command "_mirror" "_l" "" pm pt "_n")
          (command "_arc"
                   pt
                   "_e"
                   pm
                   "_r"
                   (- (distance pb pm) (/ (distance pb pm) 2.75))
          ) ;_ command
          (ssadd (entlast) ss1)
          (setq yo (ssname ss1 0))
          ;;(setq yo2 (entget yo))
          ;;(if (OR (equal (cdr (assoc 0 yo2)) "POLYLINE") (equal (cdr (assoc 0 yo2)) "LWPOLYLINE"))
          ;;(command "_pedit" yo "_j" ss1 "" "_x")
          (command "_pedit" yo "_y" "_j" ss1 "" "_x")
          ;;)
          (setq ANS nil)
          (while (and (/= ANS "J") (/= ANS "A"))
            (setq ANS
                   (strcase
                     (getstring
                       "\rLage des Symbols ok? (Abbruch/Ja/Nein): <Nein> "
                     ) ;_ getstring
                   ) ;_ strcase
            ) ;_ setq
            (if (or (= ANS "")(= ANS "N"))
              (command "_mirror" "_l" "" pm pt "_y")
            ) ;_ if
            (if (= ANS "A")
              (entdel (entlast))
            ) ;_ if
          ) ;_ while
          (command "_undo" "_end")
        ) ;_ progn
      ) ;_ if
    ) ;_ progn
  ) ;_ if
  (setvar "osmode" os)
  (setvar "cmdecho" cmd)
  (princ)
) ;_ defun
;;;------------ Draw temporary points ----------------------|
;; draws an square around a point
(defun DRAW_SQ ( pt color / dd p1 p2 p3 p4 vlist )
  (setq dd (/ (getvar "VIEWSIZE") 75.0)
        p1 (polar pt 0.785398 dd)
        p2 (polar pt 2.356194 dd)
        p3 (polar pt -2.356194 dd)
        p4 (polar pt -0.785398 dd)
  ) ;_ setq
  (setq vlist (list color p1 p2 color p2 p3 color p3 p4 color p4 p1) ;_ list
  ) ;_ setq
  (grvecs vlist)
) ;_end of defun
;;;---------------------------------------------------------|
(defun error_begin ( / oldcmd )
  (setq oldcmd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (if (tblsearch "UCS" "ROHR_UCSSAVE")
    (command "_UCS" "_SAVE" "ROHR_UCSSAVE" "_Y")
    (command "_UCS" "_SAVE" "ROHR_UCSSAVE")
  ) ;_ if
  (command "_UCS" "_W")
  (setvar "cmdecho" oldcmd)
  (if (not (boundp *#ROHR_OLDERR))
    (setq *#ROHR_OLDERR
           *error*                      ; Save acad error routine
          *error* rohr_err              ; Substitute eds routine
    ) ;_ setq
    (princ)
  ) ;_ if
) ;_ defun
;;;---------------------------------------------------------|
(defun error_end ( )
  (if (tblsearch "UCS" "ROHR_UCSSAVE")
    (progn
      (command "_UCS" "_R" "ROHR_UCSSAVE") ;Restore UCS
      (command "_UCS" "_D" "ROHR_UCSSAVE")
    ) ;_ progn
  ) ;_ if
  (if (boundp *#ROHR_OLDERR)
    (setq *error* *#ROHR_OLDERR)
    (princ)
  ) ;_ if
) ;_ defun
;;;---------------------------------------------------------|
(defun linePt ( p e1 / A B C N p1 p2 )
  ;;Linien-Endpunkt ermitteln
  (setq e1 (entget e1))
  (setq p1 (dxf 10 e1)
        p2 (dxf 11 e1)
  ) ;_ setq
  (if (< (distance p p1) (distance p p2))
    p1
    p2
  ) ;_ if
) ;_ defun
;;;---------------------------------------------------------|
(defun arcPt ( p e1 / A B C N p1 p2 )
  ;;Bogen-Endpunkt ermitteln
  (setq e1 (entget e1))
  (setq a (dxf 10 e1)                   ;the center point
        b (dxf 40 e1)                   ;the radius
        n (dxf 50 e1)                   ;the start angle
        c (dxf 51 e1)                   ;the end angle
  ) ;_ setq
                                        ;setq
  (setq p1 (polar a n b))
  (setq p2 (polar a c b))
  (if (< (distance p p1) (distance p p2))
    p1
    p2
  ) ;_ if
) ;_ defun
;;;---------------------------------------------------------|
(defun arc3 ( flag p e1 D2 / A AP1 AP2 AP3 AP4 B C N p1 p2 p3 )
  ;;Bogen-Abschlusslinien zeichnen
  (setq e1 (entget e1))
  (setq a (dxf 10 e1)                   ;the center point
        b (dxf 40 e1)                   ;the radius
        n (dxf 50 e1)                   ;the start angle
        c (dxf 51 e1)                   ;the end angle
  ) ;_ setq
                                        ;setq
  (setq p1 (polar a n b))
  (setq p2 (polar a c b))
  (setq ap1 (polar a n (- b D2)))
  (setq ap2 (polar a n (+ b D2)))
  (setq ap3 (polar a c (- b D2)))
  (setq ap4 (polar a c (+ b D2)))
  (if (= flag 1)
    (setq p3 p1)
    (setq p3 p2)
  ) ;_ if
  (if (equal p p3 0.001)
    (command "_line" ap1 ap2 "")
    (command "_line" ap3 ap4 "")
  ) ;_ if
) ;_ defun
;;;---------------------------------------------------------|
(defun isoline ( PT1 PT2 A D2 )
  ;;Rohr-Isolations-Linie zeichnen
  (command "_color" "_bylayer" "_-linetype" "_se" "verdecktx2" "") ;_ command
  (COMMAND "_LINE"
           (POLAR PT1 A D2)
           (POLAR PT2 A D2)
           ""
  ) ;_ COMMAND
) ;_ defun
;;;---------------------------------------------------------|
(defun isoarc ( e1 D2 / A AP1 AP2 AP3 AP4 B C N )
  ;;Isolierung für Bogen zeichnen
  (if (> *#iso_offset 0)
    (progn
      (setq e1 (entget e1))
      (if (= (dxf 0 e1) "ARC")
        (progn
          (setq a (dxf 10 e1)           ;the center point
                b (dxf 40 e1)           ;the radius
                n (dxf 50 e1)           ;the start angle
                c (dxf 51 e1)           ;the end angle
          )                             ;setq
          (setq ap1 (polar a n (- b D2)))
          (setq ap2 (polar a c (- b D2)))
          (setq ap3 (polar a n (+ b D2)))
          (setq ap4 (polar a c (+ b D2)))
          (command "_color"      "_bylayer"    "_-linetype"
                   "_se"         "verdecktx2"  ""
                  ) ;_ command
          (COMMAND "_ARC" "_c" a ap1 ap2)
          (COMMAND "_ARC" "_c" a ap3 ap4)
        ) ;_ progn
      ) ;_ if
    ) ;_ progn
  ) ;_ if
) ;_ defun
;;;---------------------------------------------------------|
(defun pipeline ( PT1 PT2 A D2 )
  ;;Rohr-Linie zeichnen
  (command "_color" "_bylayer" "_-linetype" "_se" "_bylayer" "") ;_ command
  (COMMAND "_LINE"
           (POLAR PT1 A D2)
           (POLAR PT2 A D2)
           ""
  ) ;_ COMMAND
) ;_ defun
;;;---------------------------------------------------------|
(defun arc2 ( e1 D2 / A AP1 AP2 AP3 AP4 B C N )
  ;;Aussen- und Innen-Bogen zeichnen
  (setq e1 (entget e1))
  (setq a (dxf 10 e1)                   ;the center point
        b (dxf 40 e1)                   ;the radius
        n (dxf 50 e1)                   ;the start angle
        c (dxf 51 e1)                   ;the end angle
  )                                     ;setq
  (setq ap1 (polar a n (- b D2)))
  (setq ap2 (polar a c (- b D2)))
  (setq ap3 (polar a n (+ b D2)))
  (setq ap4 (polar a c (+ b D2)))
  (COMMAND "_ARC" "_c" a ap1 ap2)
  (COMMAND "_ARC" "_c" a ap3 ap4)
) ;_ defun

;;;---------------------------------------------------------|
;;;
(defun ArcEndLine ( e1 r d / a c lp1 lp2 LP3 LP4 n )
  (setq e1 (entget e1))
  (setq a (dxf 10 e1)                   ;the center point
        n (dxf 50 e1)                   ;the start angle
        c (dxf 51 e1)                   ;the end angle
  )                                     ;setq
  (setq lp1 (polar a n (- r (/ d 2.0))))
  (setq lp2 (polar a c (- r (/ d 2.0))))
  (setq lp3 (polar a n (+ r (/ d 2.0))))
  (setq lp4 (polar a c (+ r (/ d 2.0))))
  (command "_line" lp1 lp3 "")
  (command "_line" lp2 lp4 "")
) ;_ defun

;;;---------------------------------------------------------|
(defun str_case ( s )
  (if (and (/= s "") (/= s nil))
    (strcase s)
    s
  ) ;_ if
) ;_ defun
;;;---------------------------------------------------------|
(defun DN_eingabe ( / D DN R )
  (if (not *#DN)
    (setq *#DN "")
  ) ;_ if
  (princ "\... zur freien Eingabe mit  \"frei\"")
  (setq DN (getstring (strcat "\nNenndurchmesser DN 15-1600  <"
                              (if *#DN
                                *#DN
                                ""
                              ) ;_ if
                              "> : "
                      ) ;_ strcat
           ) ;_ getstring
  ) ;_ setq
  (if (or (not DN) (= DN "") (= DN "DN"))
    (setq DN *#DN)
    (setq *#DN DN)
  ) ;_ if
  (cond
    ((= DN "frei")
     (setq *#R (rohr:ureal
                 1
                 ""
                 "Rohrbogen-Radius"
                 *#R
               ) ;_ rohr:ureal
           R   *#R
     ) ;_ setq
     (setq *#D (rohr:ureal
                 1
                 ""
                 "Rohr-Durchmesser"
                 *#D
               ) ;_ rohr:ureal
           D   *#D
     ) ;_ setq
    )
    (T)
  ) ;_ cond
  *#DN
) ;_ defun
;;;---------------------------------------------------------|
(defun fillet_err_code ( s / msg )
  (cond
    ((= s "OVERSIZED_RADIUS")
     (setq msg
            "OVERSIZED_RADIUS\n\nLines to fillet are too short for\nfillet radius"
     ) ;_ setq
    )
    ((= s "SHORT_LINE")
     (setq msg "SHORT_LINE\nLine is too short for fillet radius")
    )
    ((= s "SHORT_ARC")
     (setq msg "SHORT_ARC\nArc segment is too short for fillet radius")
    )
    ((= s "TANGENT_ENTITIES")
     (setq msg "TANGENT_ENTITIES\nLine is tangent to arc")
    )
    ((= s "FATAL_ERROR")
     (setq msg
            "FATAL_ERROR\nFillet arc center and endpoints are\nincalculable due to too large of a\nfillet radius"
     ) ;_ setq
    )
    ((= s "UNABLE_TO_FILLET")
     (setq msg
            "UNABLE_TO_FILLET\nLine and arc do not have a common\nendpoint and do not intersect"
     ) ;_ setq
    )
  ) ;_ cond
  (setq *#break 'T)
  msg
) ;_ defun
;;;****************** ERROR HANDLER *************************

(defun rohr_err ( s )
  (princ (strcat "\nProgramm beendet"))
  ;; VARIABLE RESETS AND COMMANDS TO PERFORM UPON ERRORS:
  (if (tblsearch "UCS" "ROHR_UCSSAVE")
    (progn
      (command "_UCS" "_R" "ROHR_UCSSAVE") ;Restore UCS
      (command "_UCS" "_D" "ROHR_UCSSAVE")
    ) ;_ progn
  ) ;_ if
  (command "_color" "_bylayer" "_-linetype" "_se" "_bylayer" "") ;_ command
  (if *#ROHR_OLDERR
    (setq
      *error*     *#ROHR_OLDERR
      *#ROHR_OLDERR nil
    ) ;_ setq
  )                                     ; Restore old *error* handler
  (redraw)
  (if (/= *#break nil)
    (progn
      (entdel *#L1A)
      (entdel *#L2A)
      (entdel *#ML1A)
      ;;
      (if *#IL1A
        (entdel *#IL1A)
      ) ;_ if
      (if *#IL2A
        (entdel *#IL2A)
      ) ;_ if
      ;;
      (setq *#break nil
            *#L1A nil
            *#L2A nil
            *#ML1A nil
            *#IL1A nil
            *#IL2A nil
      ) ;_ setq
      (alert
        "Programm wurde abgebrochen !\n\nDas letzte Stück wird gelöscht,\nder Rohranfang muß manuell geschlossen werden."
      ) ;_ alert
    ) ;_ progn
  ) ;_ if
  (moder)
  (prompt "\ ... ")

  (if (/= (getvar "errno") 0)
    (progn
      (princ "   Rohrleitung wurde nicht geschlossen. (Errno: ")
      (princ (getvar "errno"))
      (princ ")")
    ) ;_ progn
  ) ;_ if

  (princ)
) ;_ defun
;;;---------------------------------------------------------|
(defun obtuse ( a )                       ; returns T if angle a is obtuse
  (if (> a (/ pi 2))
    t
  )                                     ; (> 90 degrees), and NIL otherwise
) ;_ defun
(defun supplement ( a )                   ; self explanitory
  (- pi a)
) ;_ defun

(defun acute ( a b / c )                  ; (acute <ang1> <ang2> )
  (setq                                 ; returns absolute acute angle
    a (if (> a pi)
        (- a pi)
        a
      )                                 ; in radians between ang1 and ang2
    b (if (> b pi)
        (- b pi)
        b
      )                                 ; returns 0.0 if angles are parallel
  )                                     ; and pi/2 if they are perpendicular
  (if
    (obtuse (setq c (if (> (setq c (abs (- a b))) pi)
                      (- (* pi 2) c)
                      c
                    ) ;_ if
            ) ;_ setq
    ) ;_ obtuse
     (supplement c)
     c
  ) ;_ if
) ;_ defun
;;;---------------------------------------------------------|
;;;
(defun fillet_undo ( )
  (command "_undo" "_back")
  (command "_undo" "_end")
  (princ)
) ;_ defun
;;;---------------------------------------------------------|
;;; Winkel:0,30,45,60,90,120,135,150,180,210,240,270,300,315,330,360

(defun Winkel ( a1 )
  (setq a1 (rtd a1))
  (IF (AND (>= a1 0) (< a1 15.0))
    (SETQ a1 0)
  ) ;_ IF
  (IF (AND (>= a1 15.0) (< a1 37.0))
    (SETQ a1 30)
  ) ;_ IF
  (IF (AND (>= a1 37.0) (< a1 52.0))
    (SETQ a1 45)
  ) ;_ IF
  (IF (AND (>= a1 52.0) (< a1 75.0))
    (SETQ a1 60)
  ) ;_ IF
  (IF (AND (>= a1 75.0) (< a1 105.0))
    (SETQ a1 90)
  ) ;_ IF
  (IF (AND (>= a1 105.0) (< a1 125.0))
    (SETQ a1 120)
  ) ;_ IF
  (IF (AND (>= a1 125.0) (< a1 142.0))
    (SETQ a1 135)
  ) ;_ IF
  (IF (AND (>= a1 142.0) (< a1 165.0))
    (SETQ a1 150)
  ) ;_ IF
  (IF (AND (>= a1 165.0) (< a1 195.0))
    (SETQ a1 180)
  ) ;_ IF
  (IF (AND (>= a1 195.0) (< a1 215.0))
    (SETQ a1 210)
  ) ;_ IF
  (IF (AND (>= a1 215.0) (< a1 230.0))
    (SETQ a1 225)
  ) ;_ IF
  (IF (AND (>= a1 230.0) (< a1 255.0))
    (SETQ a1 240)
  ) ;_ IF
  (IF (AND (>= a1 255.0) (< a1 285.0))
    (SETQ a1 270)
  ) ;_ IF
  (IF (AND (>= a1 285.0) (< a1 307.0))
    (SETQ a1 300)
  ) ;_ IF
  (IF (AND (>= a1 307.0) (< a1 322.0))
    (SETQ a1 315)
  ) ;_ IF
  (IF (AND (>= a1 322.0) (< a1 345.0))
    (SETQ a1 330)
  ) ;_ IF
  (IF (AND (>= a1 345.0) (<= a1 360))
    (SETQ a1 0)
  ) ;_ IF
  (setq a1 (dtr a1))
  a1
) ;_ defun
;;;---------------------------------------------------------|
;;;
(defun GetMidpt ( p1 p2 / Midpt X1 X2 XMID Y1 Y2 YMID )
  (setq X1 (car p1))
  (setq Y1 (cadr p1))
  (setq X2 (car p2))
  (setq Y2 (cadr p2))
  (setq XMID (/ (+ X1 X2) 2))
  (setq YMID (/ (+ Y1 Y2) 2))
  (setq Midpt (list XMID YMID))
  Midpt
) ;_ defun
;;;---------------------------------------------------------|
;;;
(defun DN:NennDurchmesser ( DN / D R )
  (cond
    ((= DN "15")
     (setq R 28)
     (setq D 21.3)
    )
    ((= DN "20")
     (setq R 29)
     (setq D 26.9)
    )
    ((= DN "25")
     (setq R 38)
     (setq D 33.7)
    )
    ((= DN "32")
     (setq R 48)
     (setq D 42.5)
    )
    ((= DN "40")
     (setq R 57)
     (setq D 48.3)
    )
    ((= DN "50")
     (setq R 76)
     (setq D 60.3)
    )
    ((= DN "65")
     (setq R 95)
     (setq D 76.1)
    )
    ((= DN "80")
     (setq R 114)
     (setq D 88.9)
    )
    ((= DN "100")
     (setq R 152)
     (setq D 114.3)
    )
    ((= DN "125")
     (setq R 190)
     (setq D 139.7)
    )
    ((= DN "150")
     (setq R 229)
     (setq D 168.3)
    )
    ((= DN "200")
     (setq R 305)
     (setq D 219.1)
    )
    ((= DN "250")
     (setq R 381)
     (setq D 273)
    )
    ((= DN "300")
     (setq R 457)
     (setq D 323.9)
    )
    ((= DN "350")
     (setq R 533)
     (setq D 355.6)
    )
    ((= DN "400")
     (setq R 610)
     (setq D 406.4)
    )
    ((= DN "450")
     (setq R 686)
     (setq D 457)
    )
    ((= DN "500")
     (setq R 762)
     (setq D 508)
    )
    ((= DN "600")
     (setq R 914)
     (setq D 610)
    )
    ((= DN "700")
     (setq R 1067)
     (setq D 711)
    )
    ((= DN "800")
     (setq R 1219)
     (setq D 813)
    )
    ((= DN "900")
     (setq R 1372)
     (setq D 914)
    )
    ((= DN "1000")
     (setq R 2032)
     (setq D 1016)
    )
    ((= DN "1200")
     (setq R 2440)
     (setq D 1220)
    )
    ((= DN "1400")
     (setq R 2840)
     (setq D 1420)
    )
    ((= DN "1600")
     (setq R 3240)
     (setq D 1620)
    )
    ((= DN "frei")
     (setq R *#R)
     (setq D *#D)
    )
    (T (princ "\nKein Radius und Durchmesser gewählt"))
  ) ;_ cond
  (if (and D R)
    (cons D R)
    nil
  ) ;_ if
) ;_ defun

;;;---------------------------------------------------------|
;;;* UREAL User interface real function
;;;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET.
;;;* MSG is the prompt string, to which a default real is added as <DEF> (nil
;;;* for none), and a : is added.
;;;*
(defun rohr:ureal ( bit kwd msg def / inp )
  (if def
    (setq msg (strcat "\n" msg " <" (rtos def 2) ">: ")
          bit (* 2 (fix (/ bit 2)))
    ) ;_ setq
    (setq msg (strcat "\n" msg ": "))
  )                                     ;if
  (initget bit kwd)
  (setq inp (getreal msg))
  (if inp
    inp
    def
  ) ;_ if
)                                       ;defun
;;;---------------------------------------------------------|
;;;
(defun dxf ( a b / )
  (cdr (assoc a b))
) ;_ defun
;;;---------------------------------------------------------|
;; Convert Radians to Degrees
(defun RTD ( rad )
  (* (/ rad PI) 180)
) ;_ defun
;;;---------------------------------------------------------|
;; Convert Degrees to Radians
(defun DTR ( a )
  (* PI (/ A 180.0))
) ;_ defun
;;;*****************************************************************************
;;;*   File: ARCFILL.LSP
;;;*   Written by: Cory Gordon, Keith Bodeau, Michael Jackson
;;;*   Date started: Februray 23, 1991
;;;*   Date of last revision: 13:15:12 Monday, 11-23-1992
;;;*****************************************************************************
;;;*****************************************************************************
;;;*   Program: Arcfill
;;;*
;;;*   Description: Given a radius and two entities that are either two lines
;;;*         or an arc and a line, this program draws a fillet with the given
;;;*         radius between the two entities.  ;*
;;;*
;;;*   Required External Files:  EGET.LSP, INTERSEC.LSP, OFFENT.LSP, SAME.LSP
;;;*
;;;*   Inputs: RAD - Fillet radius
;;;*           E1 -  Entity name of first entity to fillet
;;;*           E2 -  Entity name of second entity to fillet
;;;*
;;;*   Outputs: Fillet with radius RAD between E1 and E2.
;;;*            Returns an association list of the following form:
;;;*           '(ERROR (S_PT <pt>) (E_PT <pt>) (RADIUS . <rad>) (CENTER <pt>))
;;;*            where ERROR is nil if the fillet can be drawn, and an error
;;;*            condition otherwise.
;;;*
;;;*   Notes:
;;;*      - The list returned from ARCFILL is set up so its car is an error
;;;*        code, and its cdr is an association list of fillet arc data.
;;;*        If ERROR is any value other than nil then the fillet is not drawn,
;;;*        and E1 and E2 are not modified.  The a-list containing fillet arc
;;;*        data is returned regardless of whether or not the fillet is
;;;*        actually drawn unless the ERROR code is FATAL_ERROR.  A
;;;*        FATAL_ERROR occurs when ARCFILL is unable to calculate the
;;;*        fillet arc center and endpoints.  In such a case, the arc a-list
;;;*        is not included in the return list.
;;;*
;;;*      - ERROR Codes:
;;;*          Line-Line: OVERSIZED_RADIUS - Lines to fillet are too short for
;;;*                                        fillet radius
;;;*          Arc-Line: SHORT_LINE - Line is too short for fillet radius
;;;*                    SHORT_ARC - Arc segment is too short for fillet radius
;;;*                    TANGENT_ENTITIES - Line is tangent to arc
;;;*                    FATAL_ERROR - Fillet arc center and endpoints are
;;;*                                  incalculable due to too large of a
;;;*                                  fillet radius
;;;*                    UNABLE_TO_FILLET - Line and arc do not have a common
;;;*                                       endpoint and do not intersect
;;;*
;;;*       - This function may produce unexpected results if it is passed an
;;;*         arc and a line that do not have a common endpoint.  However, if
;;;*         the endpoints are fairly close to each other in relation to the
;;;*         size of the line and arc, the expected fillet will usually be
;;;*         produced.
;;;*
;;;*       - All points in the return list are in world coordinates, even if
;;;*         a UCS is in use when ARCFILL is called.
;;;*
;;;*****************************************************************************
;;;************************* Load External Functions ***************************
(defun eget ( what entlst / )
  (cdr (assoc (cdr (assoc what
                          '((s_pt . 10)
                            (e_pt . 11)
                            (etype . 0)
                            (layer . 8)
                            (ename . -1)
                            (radius . 40)
                            (s_ang . 50)
                            (e_ang . 51)
                           )
                   ) ;_ assoc
              ) ;_ cdr
              entlst
       ) ;_ assoc
  ) ;_ cdr
) ;_ defun

;;;******************************************************************************
;;;*************** INTERESECT ***************************************************
(defun INTERSECT ( ENT1 ENT2 / C C1 C2 COSTHETA D D2 ENT ETYPE1 ETYPE2
            INTLIST P1 P2 P3 P4 R R1 R2 SINTHETA THETA XSQR
         )
;;;Returns a list of intersection points of ENT1 and ENT2.
;;;Each entity can be either a line, arc, or circle.

  (if (null EGET)
    (load "EGET")
  )                                     ;Load EGET id not already loaded

  ;;Determine type of each entity: line, arc, or circle
  (setq ETYPE1 (EGET 'ETYPE ENT1)
        ETYPE2 (EGET 'ETYPE ENT2)
  ) ;_ setq

  (cond
    ;;Process two lines
    ((and (= ETYPE1 "LINE") (= ETYPE2 "LINE"))
     (setq P1      (EGET 'S_PT ENT1)
           P2      (EGET 'E_PT ENT1)
           P3      (EGET 'S_PT ENT2)
           P4      (EGET 'E_PT ENT2)
           INTLIST (inters P1 P2 P3 P4 nil)
     ) ;_ setq
    )

    ;;Process a line and an arc
    ((or (and (= ETYPE1 "LINE") (member ETYPE2 '("CIRCLE" "ARC")))
         (and (member ETYPE1 '("CIRCLE" "ARC")) (= ETYPE2 "LINE"))
     ) ;_ or
     (setq ENT     (if (= ETYPE1 "LINE")
                     ENT1
                     ENT2
                   ) ;_ if
           P1      (EGET 'S_PT ENT)
           P2      (EGET 'E_PT ENT)
           ENT     (if (= ETYPE1 "LINE")
                     ENT2
                     ENT1
                   ) ;_ if
           C       (EGET 'S_PT ENT)
           R       (EGET 'RADIUS ENT)   ;Circle radius

           P3      (inters P1
                           P2
                           C
                           (polar C (+ (angle P1 P2) (/ pi 2.0)) 10)
                           nil
                   ) ;_ inters
           D       (distance C P3)
           XSQR    (- (expt R 2.0) (expt D 2.0))
           XSQR    (if (< (abs XSQR) 0.0000000001)
                     0.0
                     XSQR
                   ) ;_ if
           INTLIST (if (minusp XSQR)
                     nil
                     (list (polar P3 (angle P2 P1) (sqrt XSQR))
                           (polar P3 (angle P1 P2) (sqrt XSQR))
                     ) ;_ list
                   ) ;_ if
     ) ;_ setq
    )

    ;;Process two circles
    ((and (member ETYPE1 '("CIRCLE" "ARC"))
          (member ETYPE2 '("CIRCLE" "ARC"))
     ) ;_ and
     (setq C1       (EGET 'S_PT ENT1)   ;Circle 1 center
           R1       (EGET 'RADIUS ENT1) ;Circle 1 radius
           C2       (EGET 'S_PT ENT2)   ;Circle 2 center
           R2       (EGET 'RADIUS ENT2) ;Circle 2 radius
           D        (distance C1 C2)
           COSTHETA (/ (- (expt R2 2.0) (expt R1 2.0) (expt D 2.0))
                       (- (* 2.0 R1 D))
                    ) ;_ /
           INTLIST  (if (> (abs COSTHETA) 1.0)
                      nil
                      (progn
                        (setq SINTHETA (sqrt (- 1.0 (expt costheta 2.0)))
                              THETA    (atan SINTHETA COSTHETA)
                              INT1     (polar C1 (+ (angle C1 C2) THETA) R1)
                              INT2     (polar C1 (- (angle C1 C2) THETA) R1)
                        ) ;_ setq
                        (list INT1 INT2)
                      ) ;_ progn
                    ) ;_ if
     ) ;_ setq
    )

    ;;Process invalid entities
    (t (setq INTLIST 'INVALID))
  ) ;_ cond

  INTLIST                               ;Return intersection points
) ;_ defun
;;;******************************* OFFENT.LSP *****************************
;;;
;;;  WRITTEN: K BODEAU
;;;OFFENT takes an entity name of a line, arc or circle and a
;;;positive or negative offset distance and returns pseudo
;;;entity list. Returns nil if entities are invalid.

(defun OFFENT ( ENTNAME DIST / ANG ELST OUTLST )
  (setq elst (entget ENTNAME))
  (cond
    ((= "LINE" (EGET 'etype elst))
     (setq ang    (- (angle             ;gets angle of line
                       (EGET 's_pt elst)
                       (EGET 'e_pt elst)
                     ) ;_ angle
                     (/ pi 2.0)
                  )                     ;create offset line pseudo entity list
           outlst (list (cons '0 "LINE")
                        (cons '10 (polar (EGET 's_pt elst) ang DIST))
                        (cons '11 (polar (EGET 'e_pt elst) ang DIST))
                  ) ;_ list
     ) ;_ setq
    )
    ((= "ARC" (EGET 'etype elst))       ;create offset arc pseudo entity list
     (setq outlst (list (cons '0 "ARC")
                        (cons '10 (EGET 's_pt elst))
                        (cons '40 (+ (EGET 'radius elst) DIST))
                        (cons '50 (EGET 's_ang elst))
                        (cons '51 (EGET 'e_ang elst))
                  ) ;_ list
     ) ;_ setq
    )
    ((= "CIRCLE" (EGET 'etype elst))    ;create offset circle pseudo entity list
     (setq outlst (list (cons '0 "CIRCLE")
                        (cons '10 (EGET 's_pt elst))
                        (cons '40 (+ (EGET 'radius elst) DIST))
                  ) ;_ list
     ) ;_ setq
    )
    (t (setq outlst nil))
  ) ;_ cond
  outlst
) ;_ defun
;;;************************ SAME_SIDE *****************************************
;;;
;;; this will take a base pt a list of two pt's that define a line segment
;;; and a test pt and return T if both pt's are on the same side of the line
;;; or nil if they are not.  The program calculates the intersection of the
;;; two lines.  Then if the angle from the intersection point to the test point
;;; is the same as the angle from the intersection point to the base point then
;;; they are both on th esame side of the line.  If the test point lines on the
;;; segment it is considered on the same side as the base point
;;;
(defun same_side ( basept line testpt / intpt )
  (setq intpt (inters (car line)
                      (cadr line)
                      basept
                      testpt
                      nil
              ) ;_ inters
  ) ;_ setq
  (if (or (equal (angle intpt basept)
                 (angle intpt testpt)
                 1
          ) ;_ equal
          (equal intpt testpt)
      ) ;_ or
    t
    nil
  ) ;_ if
) ;_ defun
;;;*********************************** RETVAL ***********************************
;;;
(defun RETVAL ( ERROR START END RAD CENTER / )
  ;;Builds the association list of ARCENT data that is returned from ARCFILL.
  (if (= ERROR "FATAL_ERROR")
    (list ERROR)                        ;Return for fatal error
    (list ERROR                         ;Error value
          (cons 'S_PT START)            ;Fillet start point
          (cons 'E_PT END)              ;Fillet end point
          (cons 'RADIUS RAD)            ;Fillet radius
          (cons 'CENTER CENTER)         ;Fillet center
    ) ;_ list
  ) ;_ if
) ;_ defun
;;;********************************** NEARPTS ***********************************
;;;
(defun NEARPTS ( PAIR1 PAIR2 / DIST1 DIST2 DIST3 DIST4 EPT1 EPT2
            MINDIST SPT1 SPT2 TMP
         )
;;;Given pairs of points PAIR1 and PAIR2, returns a list of PAIR1 and PAIR2
;;;with the first points in each pair being the closest points between the
;;;two pairs.
  (setq SPT1    (car PAIR1)             ;Get endpoints
        EPT1    (cadr PAIR1)
        SPT2    (car PAIR2)
        EPT2    (cadr PAIR2)
        DIST1   (distance spt1 spt2)    ;Calculate distances between points
        DIST2   (distance spt1 ept2)
        DIST3   (distance ept1 spt2)
        DIST4   (distance ept1 ept2)
        MINDIST (min DIST1 DIST2 DIST3 DIST4)
                                        ;Determine shortest distance
  ) ;_ setq

  ;;Switch endpoints to make SPT1 and SPT2 the closest endpoints
  (if (or (= MINDIST DIST2) (= MINDIST DIST4))
    (setq TMP  SPT2
          SPT2 EPT2
          EPT2 TMP
    ) ;_ setq
  ) ;_ if
  (if (or (= MINDIST DIST3) (= MINDIST DIST4))
    (setq TMP  SPT1
          SPT1 EPT1
          EPT1 TMP
    ) ;_ setq
  ) ;_ if

  (list (list SPT1 EPT1) (list SPT2 EPT2)) ;Return list of PAIRS
) ;_ defun

;;;************************************ LLFILL **********************************
(defun LLFILL ( RAD E1 E2 / ANG ANG1 ANG2 ARC_CENT ARC_END ARC_STRT
            DIST DIST1 DIST2 DIST3 DIST4        EPT1 EPT2 INANG
            LINE_CODE L_PTS MOD_PT NEWENT OS PT_CODE ROHR_UCSSAVE SPT1
            SPT2 TEMP TMP
         )
  ;;Given radius RAD and line entities E1 and E2, fillet the lines with an arc
  ;;of radius RAD.

  (setq 1LINE (entget E1)               ;Get first line
        2LINE (entget E2)               ;Get second line
        SPT1  (eget 'S_PT 1LINE)        ;Get endpoints of first line
        EPT1  (eget 'E_PT 1LINE)
        SPT2  (eget 'S_PT 2LINE)        ;Get endpoints of second line
        EPT2  (eget 'E_PT 2LINE)
        L_PTS (NEARPTS (list SPT1 EPT1) (list SPT2 EPT2))
                                        ;Find nearest pts
        OS    nil
        ANG1  (angle (caar L_PTS)       ;Angle of first line
                     (cadar L_PTS)
              ) ;_ angle
        ANG2  (angle (caadr L_PTS)      ;Angle of second line
                     (cadadr L_PTS)
              ) ;_ angle
  ) ;_ setq

  ;;Rearrange order of lines to angle of line1 is greater than angle of line2
  ;;and calculate angle between them.
  (cond
    ((< ANG1 ANG2)
     (setq INANG (- ANG2 ANG1)
           L_PTS (list (cadr L_PTS) (car L_PTS))
           TEMP  ANG1
           ANG1  ANG2
           ANG2  TEMP
     ) ;_ setq
    )
    ((> ANG1 ANG2)
     (setq INANG (- ANG1 ANG2))
    )
  ) ;_ cond

  ;;If angle between lines is greater than pi, switch order of lines and
  ;;use the smaller angle between them
  (cond
    ((> INANG PI)
     (setq INANG (- (* 2 PI) INANG)
           L_PTS (list (cadr L_PTS) (car L_PTS))
           TEMP  ANG1
           ANG1  ANG2
           ANG2  TEMP
     ) ;_ setq
    )
  ) ;_ cond

  (setq ANG      (/ INANG 2)            ;Angle midway between lines
        MOD_PT   (inters (caar L_PTS)   ;Intersection of lines for
                         (cadar L_PTS)  ;center of arc
                         (caadr L_PTS)
                         (cadadr L_PTS)
                         nil
                 ) ;_ inters
        DIST     (/ RAD (/ (sin ANG) (cos ANG)))
                                        ;Distance from intersect of lines
                                        ;to endpoints of arc
        ARC_STRT (polar MOD_PT ANG1 DIST) ;Start point of arc
        ARC_END  (polar MOD_PT ANG2 DIST) ;End point of arc
        ARC_CENT (polar MOD_PT          ;Center of arc
                        (- ANG1 ANG)
                        (/ DIST (cos ANG))
                 ) ;_ polar
  ) ;_ setq

  ;;Check for valid radius and fillet if acceptable
  (if (or (> DIST (distance MOD_PT (cadar L_PTS)))
          (> DIST (distance MOD_PT (cadadr L_PTS)))
      ) ;_ or
    (setq OS "OVERSIZED_RADIUS")        ;Set flag if radius is too large to fillet
    (progn
      ;;Draw arc if valid radius
      (command "_arc" ARC_STRT "_e" ARC_END "_r" RAD) ;_ command

      ;;Move endpoints of line to endpoints of arc
      (foreach PT (list (list ARC_STRT (car L_PTS))
                        (list ARC_END (cadr L_PTS))
                  ) ;_ list
        (setq                           ;Determine which endpoint to move
          PT_CODE   (if (or (and (equal SPT1 (caadr PT))
                                 (equal EPT1 (cadadr PT))
                            ) ;_ and
                            (and (equal SPT2 (caadr PT))
                                 (equal EPT2 (cadadr PT))
                            ) ;_ and
                        ) ;_ or
                      10
                      11
                    ) ;_ if

          ;;Determine which line to change
          LINE_CODE (if (and (member SPT1 (cadr PT))
                             (member EPT1 (cadr PT))
                        ) ;_ and
                      '1LINE
                      '2LINE
                    ) ;_ if

          ;;Modify line entity to move endpoints
          NEWENT    (subst (cons PT_CODE (car PT))
                           (assoc PT_CODE (eval LINE_CODE))
                           (eval LINE_CODE)
                    ) ;_ subst
        ) ;_ setq
        (entmod NEWENT)
      ) ;_ foreach
    ) ;_ progn
  ) ;_ if

  ;;Return fillet association list to calling routine
  (RETVAL OS ARC_STRT ARC_END RAD ARC_CENT)
) ;_ defun

;;;********************************** ALFILL ************************************
(defun ALFILL ( RAD E1 E2 / ACCEPT AOFFSIGN APTANG APT_CODE ARC ARCRAD
            A_ANG CENT EPT ERROR E_ANG FILLCENT FILLPT1 FILLPT2
            FPT1ANG FPT2ANG INT1 INT1ANG INT2 INTLIST LINE LOFFSIGN
            LPT_CODE NEWENT OS PTLIST SPT S_ANG TEMP TMP
         )
;;;Given radius RAD and entities E1 and E2, one an arc and the other a line with
;;;a common endpoint, fillet the entities with an arc of radius RAD.

  (defun QUADRANT (ANG /)
    ;;Returns the quadrant angle ANG lies in
    (cond
      ((< ANG (* pi 0.50)) 1)
      ((< ANG pi) 2)
      ((< ANG (* pi 1.50)) 3)
      (t 4)
    ) ;_ cond
  ) ;_ defun

  ;;Make E1 the line and E2 the arc
  (if (= ETYPE1 "ARC")
    (setq TMP E1
          E1  E2
          E2  TMP
    ) ;_ setq
  ) ;_ if

  (setq LINE    (entget E1)             ;Get line entity
        ARC     (entget E2)             ;Get arc entity
        SPT     (EGET 'S_PT LINE)       ;Get first endpoint of line
        EPT     (EGET 'E_PT LINE)       ;Get second endpoint of line
        S_ANG   (EGET 'S_ANG ARC)       ;Get start point of arc
        E_ANG   (EGET 'E_ANG ARC)       ;Get end point of arc
        CENT    (EGET 'S_PT ARC)        ;Get center of arc
        ARCRAD  (EGET 'RADIUS ARC)      ;Get radius of arc
        OS      nil                     ;Oversized radius flag

        ;;List of endpoints of entities with nearest endpoints listed first
        PTLIST  (NEARPTS (list SPT EPT)
                         (list (polar CENT S_ANG ARCRAD)
                               (polar CENT E_ANG ARCRAD)
                         ) ;_ list
                ) ;_ NEARPTS

        INTLIST (intersect LINE ARC)    ;Intersections of line and arc circ
  ) ;_ setq

  (if (and INTLIST (listp INTLIST))
    (progn
      ;;Choose which intersection point to use for fillet by
      ;;adding the distances of each intersection to each of
      ;;the two nearest endpoints and then selecting
      ;;the intersection point with the least combined distance.
      (setq INT1     (if (< (+ (distance (caar PTLIST) (car INTLIST))
                               (distance (caadr PTLIST) (car INTLIST))
                            ) ;_ +
                            (+ (distance (caar PTLIST) (cadr INTLIST))
                               (distance (caadr PTLIST) (cadr INTLIST))
                            ) ;_ +
                         ) ;_ <
                       (car INTLIST)
                       (cadr INTLIST)
                     ) ;_ if
            INT2     (if (equal INT1 (car INTLIST))
                                        ;Second intersection
                       (cadr INTLIST)
                       (car INTLIST)
                     ) ;_ if

            ;;Determine which direction to offset circle: Inside (-1.0) if
            ;;line lies inside curve of arc, outside (1.0) otherwise.
            AOFFSIGN (cond
                       ((<= (distance (cadar PTLIST) CENT) ARCRAD)
                        -1.0
                       )
                       ((< (distance (cadar PTLIST) INT2)
                           (distance (caar PTLIST) (cadar PTLIST))
                        ) ;_ <
                        -1.0
                       )
                       (t 1.0)
                     ) ;_ cond

            ;;Set offset direction of line to the side that the arc endpoint
            ;;lies on
            LOFFSIGN (if (SAME_SIDE (cadadr PTLIST)
                                    (list SPT EPT)
                                    (cdr (assoc 10 (OFFENT E1 1.0)))
                         ) ;_ SAME_SIDE
                       1.0
                       -1.0
                     ) ;_ if

            ;;Code of line endpoint to change
            LPT_CODE (if (equal (caar PTLIST) SPT 0.00001)
                       10
                       11
                     ) ;_ if

            ;;Code of arc endpoint to change
            APT_CODE (if (equal (caadr PTLIST)
                                (polar CENT S_ANG ARCRAD)
                                0.00001
                         ) ;_ equal
                       50
                       51
                     ) ;_ if

            ACCEPT   nil
      ) ;_ setq

      (while (not ACCEPT)               ;Do not accept fillet until it is correct
        ;;Center of fillet is the intersection of offseted
        ;;line and arc circle
        (setq FILLCENT (INTERSECT (OFFENT E1 (* LOFFSIGN RAD))
                                  (OFFENT E2 (* AOFFSIGN RAD))
                       ) ;_ INTERSECT
        ) ;_ setq
        ;;Calculate fillet endpoint FILLPT2 if FILLCENT is not nil
        (if FILLCENT
          (progn
            (setq
              ;;Determine which intersection to use for fillet center
              FILLCENT (if (<= (distance (car FILLCENT) INT1)
                               (distance (cadr FILLCENT) INT1)
                           ) ;_ <=
                         (car FILLCENT)
                         (cadr FILLCENT)
                       ) ;_ if

              ;;Fillet endpoint on arc
              FILLPT2  (polar CENT (angle CENT FILLCENT) ARCRAD)

              ;;Angle from arc center to fillet center
              INT1ANG  (angle CENT INT1)

              ;;Angle from arc center to fillet endpt
              FPT2ANG  (angle CENT FILLPT2)
            ) ;_ setq

            ;;Determine if fillet is correct by wheter or not it increases
            ;;the length of the arc segment.  If it is incorrect then offset
            ;;the line to the other side and recalculate fillet center and
            ;;endpoint on arc.
            (if (= APT_CODE 51)
              (progn
                (if (> (- INT1ANG FPT2ANG) pi)
                  (setq FPT2ANG (+ FPT2ANG (* pi 2.0)))
                  (if (> (- FPT2ANG INT1ANG) pi)
                    (setq FPT2ANG (- FPT2ANG (* pi 2.0)))
                  ) ;_ if
                ) ;_ if
                (if (> FPT2ANG INT1ANG)
                  (setq LOFFSIGN (- LOFFSIGN))
                  (setq ACCEPT t)
                ) ;_ if
              ) ;_ progn
              (progn
                (if (> (- INT1ANG FPT2ANG) pi)
                  (setq INT1ANG (- INT1ANG (* pi 2.0)))
                  (if (> (- FPT2ANG INT1ANG) pi)
                    (setq FPT2ANG (- FPT2ANG (* pi 2.0)))
                  ) ;_ if
                ) ;_ if
                (if (< FPT2ANG INT1ANG)
                  (setq LOFFSIGN (- LOFFSIGN))
                  (setq ACCEPT t)
                ) ;_ if
              ) ;_ progn
            ) ;_ if
          ) ;_ progn
          (setq ACCEPT t)               ;Accept if FILLCENT is nil
        ) ;_ if
      ) ;_ while

      ;;Calculate the fillet endpoint FILLPT1 if FILLCENT is not nil
      (if FILLCENT
        (setq FILLPT1 (inters INT1
                              (cadar PTLIST)
                              FILLCENT
                              (polar FILLCENT
                                     (+ (angle INT1 (cadar PTLIST))
                                        (/ pi 2.0)
                                     ) ;_ +
                                     1.0
                              ) ;_ polar
                              nil
                      ) ;_ inters
        ) ;_ setq
      ) ;_ if

      ;;Set ERROR to error condition or to nil if o.k. to draw
      (setq ERROR (cond
                    ;;Offset line and arc do not intersect
                    ((null FILLCENT)
                     "FATAL_ERROR"
                    )

                    ;;Fillet endpoint is past end of line
                    ((> (distance INT1 FILLPT1)
                        (distance INT1 (cadar PTLIST))
                     ) ;_ >
                     "SHORT_LINE"
                    )

                    ;;Fillet endpoint is past end of arc
                    ((if (= APT_CODE 51)
                       (progn
                         (setq APTANG (angle CENT (cadadr PTLIST)))
                         (if (> (- APTANG FPT2ANG) pi)
                           (setq APTANG (- APTANG (* pi 2.0)))
                           (if (> (- FPT2ANG INT1ANG) pi)
                             (setq FPT2ANG (- FPT2ANG (* pi 2.0)))
                           ) ;_ if
                         ) ;_ if
                         (< FPT2ANG APTANG)
                       ) ;_ progn
                       (progn
                         (setq APTANG (angle CENT (cadadr PTLIST)))
                         (if (> (- APTANG FPT2ANG) pi)
                           (setq FPT2ANG (+ FPT2ANG (* pi 2.0)))
                           (if (> (- FPT2ANG APTANG) pi)
                             (setq APTANG (+ APTANG (* pi 2.0)))
                           ) ;_ if
                         ) ;_ if
                         (> FPT2ANG APTANG)
                       ) ;_ progn
                     ) ;_ if
                     "SHORT_ARC"
                    )

                    (t nil)             ;Else no error
                  ) ;_ cond
      ) ;_ setq

      ;;Draw fillet arc if no error condition
      (if (not ERROR)
        (progn
          ;;Move line endpoint that is common with arc to endpoint1
          ;;of fillet
          (setq NEWENT (subst (cons LPT_CODE FILLPT1)
                              (assoc LPT_CODE LINE)
                              LINE
                       ) ;_ subst
          ) ;_ setq
          (entmod NEWENT)

          ;;Move arc endpoint that is common with line to endpoint2
          ;;of fillet
          (setq NEWENT (subst (cons APT_CODE (angle CENT FILLPT2))
                              (assoc APT_CODE ARC)
                              ARC
                       ) ;_ subst
          ) ;_ setq
          (entmod NEWENT)

          ;;If necessary switch fillet arc endpoints to get proper orientation.
          (setq FPT1ANG (angle FILLCENT FILLPT1)
                                        ;Angles from fillet center to
                FPT2ANG (angle FILLCENT FILLPT2) ;fillet endpoints
          ) ;_ setq
          ;;Conditions to switch endpoints so fillet will be small arc from
          ;;FILLPT1 to FILLPT2 when drawn counterclockwise.
          (if
            (or (and (= (QUADRANT FPT1ANG) 1) (= (QUADRANT FPT2ANG) 4))
                (and (= (QUADRANT FPT1ANG) 1)
                     (= (QUADRANT FPT2ANG) 3)
                     (> (- FPT2ANG FPT1ANG) pi)
                ) ;_ and
                (and (= (QUADRANT FPT1ANG) 3)
                     (= (QUADRANT FPT2ANG) 1)
                     (< (- FPT1ANG FPT2ANG) pi)
                ) ;_ and
                (and (> FPT1ANG FPT2ANG)
                     (not (and (= (QUADRANT FPT2ANG) 1)
                               (= (QUADRANT FPT1ANG) 4)
                          ) ;_ and
                     ) ;_ not
                ) ;_ and
            ) ;_ or
             ;;Switch fillet endpoints
             (setq TEMP    FILLPT1
                   FILLPT1 FILLPT2
                   FILLPT2 TEMP
             ) ;_ setq
          ) ;_ if

          ;;Draw fillet arc
          (if (equal FILLPT1 FILLPT2)
            (setq ERROR "TANGENT_ENTITIES")
            (command "_ARC" "_C" FILLCENT FILLPT1 FILLPT2)
          ) ;_ if
        ) ;_ progn
      ) ;_ if

      ;;Return fillet association list to calling routine
      (RETVAL ERROR FILLPT1 FILLPT2 RAD FILLCENT)
    ) ;_ progn

    "UNABLE_TO_FILLET"
  ) ;_ if
) ;_ defun

;;;********************************** ARCFILL ***********************************
(defun ARCFILL ( RAD E1 E2 / ETYPE1 ETYPE2 EXITCODE ROHR_UCSSAVE )
  ;;Fillet entities whose names are E1 and E2 with a fillet of radius RAD

  ;;Save current UCS origin and set UCS to world coords
  ;;(if (tblsearch "UCS" "ROHR_UCSSAVE")
  ;;  (command "_UCS" "_SAVE" "ROHR_UCSSAVE" "_Y")
  ;;  (command "_UCS" "_SAVE" "ROHR_UCSSAVE")
  ;;)
  ;;(command "_UCS" "_W")
  (setq ETYPE1 (EGET 'ETYPE (entget E1)) ;Get type of E1
        ETYPE2 (EGET 'ETYPE (entget E2)) ;Get type of E2
  ) ;_ setq

  ;;Call appropriate fillet routine based on entity types
  (cond
    ;;Fillet a line and a line
    ((and (= ETYPE1 "LINE") (= ETYPE2 "LINE"))
     (setq EXITCODE (LLFILL RAD E1 E2))
    )

    ;;Fillet a line and an arc
    ((or (and (= ETYPE1 "LINE") (= ETYPE2 "ARC"))
         (and (= ETYPE1 "ARC") (= ETYPE2 "LINE"))
     ) ;_ or
     (setq EXITCODE (ALFILL RAD E1 E2))
    )
  ) ;_ cond
  ;;(command "_UCS" "_R" "ROHR_UCSSAVE")   ;Restore UCS
  ;;(command "_UCS" "_D" "ROHR_UCSSAVE")
  EXITCODE
) ;_ defun

;;; ------------------- Bogen an Bogen ---------------------|
(DEFUN bogb ( lst DN D D2 RD / ANSWER API ARC_LAST AU BA BP CA CA1 CR
            CTR E EA EP ES FLAG LR ph PP SA
         )
  (command "_undo" "_be")
  (SETVAR "OSMODE" 0)
  (if (boundp 'lst)
    (setq ES (nth 2 lst))
    (SETQ ES (ENTSEL "\nBogen-Ende picken: "))
  ) ;_ if
  (if ES
    (progn
      (if (= (dxf 0
                  (entget (if (boundp 'lst)
                            ES
                            (car ES)
                          ) ;_ if
                  ) ;_ entget
             ) ;_ dxf
             "ARC"
          ) ;_ =
        (progn
          (if (boundp 'lst)
            (progn
              (setq E (ENTGET (nth 2 lst)))
              (setq PP (arcPt (nth 1 lst) (nth 2 lst)))
            ) ;_ progn
            (progn
              (setq E (ENTGET (CAR ES)))
              (setq PP (arcPt (CADR ES) (car ES)))
            ) ;_ progn
          ) ;_ if
          (SETQ
            AU  (GETVAR "AUNITS")
            CTR (CDR (ASSOC '10 E))
            BA  (CDR (ASSOC '50 E))
            EA  (CDR (ASSOC '51 E))
            CR  (CDR (ASSOC '40 E))
          ) ;_ SETQ
          (draw_sq PP 2)
          (SETVAR "AUNITS" 0)
          (INITGET "30 45 60 90")
          (princ "\nGültige Winkel: 30, 45, 60, 90 Grad")
          (SETQ CA (GETKWORD "\n   Bogenwinkel: "))
          (if CA
            (progn
              (setq CA (dtr (atoi CA)))
              (setq CA1 CA)
              (SETQ BP (POLAR CTR BA CR))
              (SETQ EP (POLAR CTR EA CR))
              (setq LR "L")
              (setq flag nil)
              (setq PH PI)
              (while (not flag)
                (if (= LR "L")
                  (setq LR "R")
                  (setq LR "L")
                ) ;_ if
                (SETVAR "AUNITS" AU)
                (IF (EQUAL PP BP)
                  (SETQ API (IF (= LR "R")
                              PH        ;PI
                              0
                            ) ;_ IF
                  ) ;_ SETQ
                ) ;_ IF
                (IF (EQUAL PP EP)
                  (SETQ API (IF (= LR "R")
                              0
                              PH        ;PI
                            ) ;_ IF
                  ) ;_ SETQ
                ) ;_ IF
                (SETQ CTR (POLAR PP (- (ANGLE CTR PP) API) RD))
                (SETQ SA (ANGTOS CA 1 15))
                (IF (= LR "R")
                  (SETQ SA (STRCAT "-" SA))
                ) ;_ IF
                (command "_color" "1" "_-linetype" "_se" "mittex2" "")
                (command "_undo" "_mark")
                (COMMAND "_ARC" PP "_C" CTR "_A" SA)
                (setq arc_last (entlast))
                (command "_color"     "_bylayer"   "_-linetype"
                         "_se"        "_bylayer"   ""
                        ) ;_ command
                 (SETVAR "AUNITS" AU)
                (arc2 (entlast) D2)
                (if (> *#iso_offset 0)
                  (isoarc arc_last (+ D2 *#iso_offset))
                ) ;_ if
                (arc3 1 PP arc_last D2)
                (arc3 2 PP arc_last D2)
                (princ)
                (SETQ answer
                       (GETstring "\rWinkelrichtung ok? (Abbruch/Ja) <Nein>: "
                       ) ;_ GETstring
                ) ;_ SETQ
                (setq answer (str_case answer))
                (cond
                  ((= answer "A")
                   (command "_undo" "_back")
                   (setq flag 'T)
                  )
                  ((= answer "J")
                   (setq flag 'T)
                  )
                  (T
                   (command "_undo" "_back")
                   (setq flag nil)
                   (setq PH (if (= PH PI)
                              (* 2 PH)
                              PH
                            ) ;_ if
                   ) ;_ setq
                  )
                ) ;_ cond
              ) ;_ while
              (SETVAR "AUNITS" AU)
            ) ;_ progn
          ) ;_ if
        ) ;_ progn
        (alert "Kein Bogen")
      ) ;_ if
      (redraw)
    ) ;_ progn
  ) ;_ if
  (command "_color" "_bylayer" "_-linetype" "_se" "_bylayer" "") ;_ command
  (command "_undo" "_end")
  (PRINC)
) ;_ DEFUN

;;; ------------------- Winkellinien zu Bogen --------------|
;;wird auch von C:BOGW aufgerufen
(defun bogw ( DN D D2 R / alst ARC_LAST CNT cp DN_LST ep L1 L2 OS OT
               sp
            )
  (setq ot (getvar "orthomode"))
  (setq os (getvar "osmode"))
  (setvar "orthomode" 0)
  (setvar "osmode" 0)
  (if (not *#DN)
    (setq *#DN "")
  ) ;_ if
  (if (= *#DN "")
    (setq DN (getstring (strcat "\nNenndurchmesser DN <"
                                (if *#DN
                                  *#DN
                                  ""
                                ) ;_ if
                                "> : "
                        ) ;_ strcat
             ) ;_ getstring
    ) ;_ setq
  ) ;_ if
  (redraw)
  (setq cnt 0)
  (setq L1 'T
        L2 'T
  ) ;_ setq
  (while (< cnt 1)
    (command "_undo" "_be")
    (setq L1 (car (entsel "\n1. Winkel-Linie ")))
    (if L1
      (redraw L1 3)
    ) ;_ if
    (setq L2 (car (entsel "\n2. Winkel-Linie ")))
    (if L2
      (redraw L2 3)
    ) ;_ if
    (if (and L1 L2)
      (progn
        (command "_color" "1" "_-linetype" "_se" "mittex2" "")
        (setq alst (arcfill R L1 L2))
        (if (car alst)
          (progn
            (setq cp (cdr (nth 4 alst))
                  sp (cdr (nth 1 alst))
                  ep (cdr (nth 2 alst))
            ) ;_ setq
            (COMMAND "_ARC" "_c" cp sp ep)
          ) ;_ progn
        ) ;_ if
        (setq arc_last (entlast))
        (command "_color" "_bylayer" "_-linetype" "_se" "_bylayer" "") ;_ command
        (if (> *#iso_offset 0)
          (isoarc arc_last (+ D2 *#iso_offset))
        ) ;_ if
        (arc2 arc_last D2)
        (arcEndLine arc_last R D)
        (if L1
          (entdel L1)
        ) ;_ if
        (if L2
          (entdel L2)
        ) ;_ if
        (command "_undo" "_end")
      ) ;_ progn
      (progn
        (setq cnt (1+ cnt))
        (if L1
          (redraw L1 4)
        ) ;_ if
        (if L2
          (redraw L2 4)
        ) ;_ if
      ) ;_ progn
    ) ;_ if
  ) ;_ while
  (setvar "orthomode" ot)
  (setvar "osmode" os)
  (princ)
) ;_ defun

;;; ------------------- Bogen frei setzen ------------------|

(defun bogf ( lst DN D D2 RD / ANG ang1 ANSWER ARC_LAST AU BP CA CTR E
               E1 EP FLAG LA LR PH pt1 pt2 pt3 SA
            )
  (if (boundp 'lst)
    (setq PT1 (nth 1 lst))
    (SETQ PT1 (GETPOINT "\nBogen-Startpunkt: "))
  ) ;_ if
  (if pt1
    (progn
      (SETQ
        ang1 (GETangle PT1 "\nEinfügewinkel eingeben oder picken: ")
      ) ;_ SETQ
      (if ang1
        (progn
          (SETQ pt2 (polar pt1 ang1 D)
                pt3 (polar pt1 (+ ang1 pi) D)
          ) ;_ SETQ
          (SETVAR "OSMODE" 0)
          (SETVAR "cmdecho" 0)
          (SETQ
            AU (GETVAR "AUNITS")
            BP pt1
            PH (/ PI 2.0)
            EP pt2
          ) ;_ SETQ
          (redraw)
          (grdraw pt2 pt3 2 3)
          (grdraw pt1 (polar pt1 (+ ang1 ph) D2) 3 0)
          (grdraw pt1 (polar pt1 (- ang1 ph) D2) 3 0)
          (SETQ EP (IF (EQUAL BP EP)
                     BP
                     EP
                   ) ;_ IF
          ) ;_ SETQ
          (SETVAR "AUNITS" 0)           ;DMS INPUT
          (princ "\nGültige Winkel: 30, 45, 60, 90 Grad")
          (INITGET "30 45 60 90")
          (SETQ CA (GETKWORD "\n   Bogenwinkel: "))
          (if CA
            (progn
              ;;(SETQ CA (GETstring "\n   Bogenwinkel: "))
              (setq CA (dtr (atoi CA)))
              (SETQ LR "L")
              (setq flag nil)
              (command "_undo" "_begin")
              (while (not flag)
                (if (= LR "L")
                  (setq LR "R")
                  (setq LR "L")
                ) ;_ if
                (IF (= LR "R")
                  (SETQ PH (- PH))
                ) ;_ IF
                (SETQ LA (ANGLE EP BP))
                (SETQ ANG (+ PH LA))
                (SETQ CTR (POLAR BP ANG RD))
                (SETQ SA (ANGTOS CA 1 15))
                (IF (= LR "R")
                  (SETQ SA (STRCAT "-" SA))
                ) ;_ IF
                (command "_color" "1" "_-linetype" "_se" "mittex2" "")
                (COMMAND "_ARC" BP "_C" CTR "_A" SA)
                (setq arc_last (entlast))
                (command "_color"     "_bylayer"   "_-linetype"
                         "_se"        "_bylayer"   ""
                        ) ;_ command
                (if (> *#iso_offset 0)
                  (isoarc arc_last (+ D2 *#iso_offset))
                ) ;_ if
                (arc2 arc_last D2)
                (arc3 1 BP arc_last D2)
                (arc3 2 BP arc_last D2)
                (SETQ answer
                       (GETstring "\nWinkelrichtung ok? (Abbruch/Ja) <Nein>: "
                       ) ;_ GETstring
                ) ;_ SETQ
                (setq answer (str_case answer))
                (cond
                  ((= answer "A")
                   (command "_undo" "_back")
                   (command "_undo" "_m")
                   (setq flag 'T)
                  )
                  ((= answer "J")
                   (setq flag 'T)
                  )
                  (T
                   (command "_undo" "_back")
                   (command "_undo" "_m")
                   (setq flag nil)
                   ;;(setq PH (if (minusp PH) (- PH) PH ))
                  )
                ) ;_ cond
              ) ;_ while
              (SETVAR "AUNITS" AU)
              (command "_undo" "_end")
            ) ;_ progn
          ) ;_ if
        ) ;_ progn
      ) ;_ if
    ) ;_ progn
  ) ;_ if
  (redraw)
  (PRINC)
) ;_ defun

;;; ------------------- Bogen an Linie ---------------------|

(defun bogl ( lst DN D D2 RD / ANG ANSWER ARC_LAST AU BP CA CTR E E1
               EP FLAG LA LR PH SA
            )
  (redraw)
  (command "_undo" "_be")
  (SETVAR "OSMODE" 0)
  (if (boundp 'lst)
    (setq E (nth 2 lst))
    (setq E (ENTSEL "\nLinien-Ende picken "))
  ) ;_ if
  (if E
    (progn
      (if (boundp 'lst)
        (setq E1 (ENTGET (nth 2 lst)))
        (setq E1 (ENTGET (CAR E)))
      ) ;_ if
      (if (= (dxf 0 E1) "LINE")
        (progn
          (if (boundp 'lst)
            (setq BP (linePt (nth 1 lst) (nth 2 lst)))
            (setq BP (linePt (CADR E) (CAR E)))
          ) ;_ if
          (SETQ
            AU (GETVAR "AUNITS")
            PH (/ PI 2.0)
            EP (CDR (ASSOC '10 E1))
          ) ;_ SETQ
          (SETQ EP (IF (EQUAL BP EP)
                     (CDR (ASSOC '11 E1))
                     EP
                   ) ;_ IF
          ) ;_ SETQ
          (SETVAR "AUNITS" 0)           ;DMS INPUT
          (draw_sq BP 2)
          (princ "\nGültige Winkel: 30, 45, 60, 90 Grad")
          (INITGET "30 45 60 90")
          (SETQ CA (GETKWORD "\n   Bogenwinkel: "))
          (if CA
            (progn
              (setq CA (dtr (atoi CA)))
              (SETQ LR "L")
              (setq flag nil)
              (while (not flag)
                (if (= LR "L")
                  (setq LR "R")
                  (setq LR "L")
                ) ;_ if
                (IF (= LR "R")
                  (SETQ PH (- PH))
                ) ;_ IF
                (SETQ LA (ANGLE EP BP))
                (SETQ ANG (+ PH LA))
                (SETQ CTR (POLAR BP ANG RD))
                (SETQ SA (ANGTOS CA 1 15))
                (IF (= LR "R")
                  (SETQ SA (STRCAT "-" SA))
                ) ;_ IF
                (command "_undo" "_mark")
                (command "_color" "1" "_-linetype" "_se" "mittex2" "")
                (COMMAND "_ARC" BP "_C" CTR "_A" SA)
                (setq arc_last (entlast))
                (command "_color"     "_bylayer"   "_-linetype"
                         "_se"        "_bylayer"   ""
                        ) ;_ command
                (if (> *#iso_offset 0)
                  (isoarc arc_last (+ D2 *#iso_offset))
                ) ;_ if
                (arc2 arc_last D2)
                (arc3 1 BP arc_last D2)
                (arc3 2 BP arc_last D2)
                (initget 1)
                (SETQ answer
                       (GETstring "\rWinkelrichtung ok? (Abbruch/Ja) <Nein>: "
                       ) ;_ GETstring
                ) ;_ SETQ
                (setq answer (str_case answer))
                (cond
                  ((= answer "A")
                   (command "_undo" "_back")
                   (command "_color"     "_bylayer"   "_-linetype"
                            "_se"        "_bylayer"   ""
                           ) ;_ command
                   (setq flag 'T)
                  )
                  ((= answer "J")
                   (setq flag 'T)
                  )
                  (T
                   (command "_undo" "_back")
                   (setq flag nil)
                   (setq PH (if (minusp PH)
                              (- PH)
                              PH
                            ) ;_ if
                   ) ;_ setq
                  )
                ) ;_ cond
              ) ;_ while
            ) ;_ progn
          ) ;_ if
          (SETVAR "AUNITS" AU)
        ) ;_ progn
        (alert "Keine Linie")
      ) ;_ if
    ) ;_ progn
  ) ;_ if
  (redraw)
  (command "_undo" "_end")
  (command "_color" "_bylayer" "_-linetype" "_se" "_bylayer" "") ;_ command
  (PRINC)
) ;_ defun
;;; -------------------- Rohr schliessen -------------------|
(defun rabs ( DN D D2 R / A A1 ANG anz AU B BP c CA CTR E E1 EP LA LP1
               LP2 LP3 LP4 LR N p1 p2 PH SA ss
            )
  (SETVAR "OSMODE" 0)
  (while (setq E (ENTSEL
                   "\rMittel-Linie nahe am Ende des Rohrstücks picken: "
                 ) ;_ ENTSEL
         ) ;_ setq
    (command "_undo" "_be")
    (SETQ E1 (ENTGET (CAR E)))
    (if (= (dxf 0 E1) "LINE")
      (progn
        (SETQ
          BP (linePt (CADR E) (CAR E))
          EP (CDR (ASSOC '10 E1))
          PH (/ PI 2.0)
        ) ;_ SETQ
        (SETQ EP (IF (EQUAL BP EP)
                   (CDR (ASSOC '11 E1))
                   EP
                 ) ;_ IF
        ) ;_ SETQ
        (setq A1 (angle BP EP))
        (grdraw (dxf 10 E1) (dxf 11 E1) 2 -1)
        (draw_sq BP 2)
        (command "_undo" "_mark")
        (setq p1 (polar BP (+ A1 PH) D2)
              p2 (POLAR BP (- A1 PH) D2)
        ) ;_ setq
        (command "_color" "_bylayer" "_-linetype" "_se" "_bylayer" "") ;_ command
        (command "_line" p1 p2 "")
      ) ;_ progn
      (progn
        (if (= (dxf 0 E1) "ARC")
          (progn
            (SETQ BP (arcPt (CADR E) (CAR E)))
            (draw_sq BP 2)
            (setq e1 (entget (car E)))
            (setq a (dxf 10 e1)         ;the center point
                  b (dxf 40 e1)         ;the radius
                  n (dxf 50 e1)         ;the start angle
                  c (dxf 51 e1)         ;the end angle
            )                           ;setq
            (setq p1 (polar a n b))
            (setq p2 (polar a c b))
            (setq lp1 (polar a n (- b (/ d 2.0))))
            (setq lp2 (polar a n (+ b (/ d 2.0))))
            (setq lp3 (polar a c (- b (/ d 2.0))))
            (setq lp4 (polar a c (+ b (/ d 2.0))))
            (command "_color"     "_bylayer"   "_-linetype"
                     "_se"        "_bylayer"   ""
                    ) ;_ command
            (if (equal BP p1 0.001)
              (command "_line" lp1 lp2 "")
              (command "_line" lp3 lp4 "")
            ) ;_ if
          ) ;_ progn
          (alert "Keine Linie oder Bogen")
        ) ;_ if
      ) ;_ progn
    ) ;_ if
    (command "_undo" "_end")
  ) ;_ while
  (redraw)
  (princ)
) ;_ defun
;;; -------------------- Isolierung schliessen -------------|
(defun iabs ( DN D D2 R / A A1 ANG anz AU B BP c CA cmd CTR E E1 EP LA
               LP1 LP2 LP3 LP4 LR N osm p1 p2 PH S SA ss
            )
  (setq cmd (getvar "cmdecho"))
  (setq osm (getvar "osmode"))
  (SETVAR "OSMODE" 0)
  (SETVAR "CMDECHO" 0)
  (while (setq E (ENTSEL
                   "\rMittel-Linie nahe am Ende des Rohrstücks picken: "
                 ) ;_ ENTSEL
         ) ;_ setq
    (command "_undo" "_be")
    (SETQ E1 (ENTGET (CAR E)))
    (if (= (dxf 0 E1) "LINE")
      (progn
        (SETQ
          BP (linePt (CADR E) (CAR E))
          EP (CDR (ASSOC '10 E1))
          PH (/ PI 2.0)
        ) ;_ SETQ
        (SETQ EP (IF (EQUAL BP EP)
                   (CDR (ASSOC '11 E1))
                   EP
                 ) ;_ IF
        ) ;_ SETQ
        (setq A1 (angle BP EP))
        (grdraw (dxf 10 E1) (dxf 11 E1) 2 -1)
        (draw_sq BP 2)
        (command "_undo" "_mark")
        (setq p1 (polar BP (+ A1 PH) (+ D2 *#iso_offset))
              p2 (POLAR BP (- A1 PH) (+ D2 *#iso_offset))
        ) ;_ setq
        (command "_color" "_bylayer" "_-linetype" "_se" "_bylayer" "") ;_ command
        (command "_color"      "_bylayer"    "_-linetype"
                 "_se"         "verdecktx2"  ""
                ) ;_ command
        (command "_line" p1 (polar p1 (- A1 PH) *#iso_offset) "")
        (command "_line" p2 (polar p2 (+ A1 PH) *#iso_offset) "")
        (command "_color" "_bylayer" "_-linetype" "_se" "_bylayer" "") ;_ command
      ) ;_ progn
      (progn
        (if (= (dxf 0 E1) "ARC")
          (progn
            (SETQ BP (arcPt (CADR E) (CAR E)))
            (draw_sq BP 2)
            (setq e1 (entget (car E)))
            (setq c (dxf 10 e1)         ;the center point
                  r (dxf 40 e1)         ;the radius
                  s (dxf 50 e1)         ;the start angle
                  e (dxf 51 e1)         ;the end angle
            )                           ;setq
            (setq p1 (polar c s r))
            (setq p2 (polar c e r))
            (setq lp1 (polar c s (- r (+ d2 *#iso_offset))))
            (setq lp2 (polar c s (+ r (+ d2 *#iso_offset))))
            (setq lp3 (polar c e (- r (+ d2 *#iso_offset))))
            (setq lp4 (polar c e (+ r (+ d2 *#iso_offset))))
            (command "_color"     "_bylayer"   "_-linetype"
                     "_se"        "_bylayer"   ""
                    ) ;_ command
            (command "_color"      "_bylayer"    "_-linetype"
                     "_se"         "verdecktx2"  ""
                    ) ;_ command
            (if (equal BP p1 0.001)
              (progn
                (command "_line" lp1 (polar lp1 s *#iso_offset) "")
                (command "_line"
                         lp2
                         (polar lp2 s (* -1 *#iso_offset))
                         ""
                ) ;_ command
              ) ;_ progn
              (progn
                (command "_line" lp3 (polar lp3 e *#iso_offset) "")
                (command "_line"
                         lp4
                         (polar lp4 e (* -1 *#iso_offset))
                         ""
                ) ;_ command
              ) ;_ progn
            ) ;_ if
            (command "_color"     "_bylayer"   "_-linetype"
                     "_se"        "_bylayer"   ""
                    ) ;_ command
          ) ;_ progn
          (alert "Keine Linie oder Bogen")
        ) ;_ if
      ) ;_ progn
    ) ;_ if
    (command "_undo" "_end")
  ) ;_ while
  (setvar "cmdecho" cmd)
  (setvar "osmode" osm)
  (redraw)
  (princ)
) ;_ defun

;;; ------------------ Iso-Linien zeichnen 1 ---------------|
(defun isol1 ( DN D D2 R / A A1 AANG AAPE AAPS ABPE ABPS AFPE AFPS
                ANFP ANGLE1 ANGLE2 AP10 AP11 arc_last ASPE ASPS B CA
                CB CF CNT CS E E1 flag IA IB IFi ISe LAP10 LAP11 LBP10
                LBP11 LFP10 LFP11 LSP10 LSP11 LST os PT1 PT2 yn
             )
  (modes)
  (setvar "osmode" 0)
  ;;(if (or(= *#iso_offset 0)(= *#iso_offset nil))
  (c:iso)
  ;;) ;_ if
  (if (= *#iso_offset 0)
    (progn
      (alert
        "Abstand der Isolationslinien vom Rohr nicht eingestellt,\nProgramm wird beendet"
      ) ;_ alert
      (exit)
    ) ;_ progn
  ) ;_ if
  (SETQ CNT 1)
  (while (and (setq e1 (car (entsel "\rRohr-Mittel-Linie picken:                             ")))
              (> *#iso_offset 0)
         ) ;_ and
    (command "_undo" "_begin")
    (setq e (entget e1))
    (if (> *#iso_offset 0)
      (progn
        (if (= (dxf 0 e) "ARC")
          (progn
            (IF (= CNT 1)
              (progn
                (SETQ IA  E1
                      IFi IA
                ) ;_ SETQ
              ) ;_ progn
            )                           ;End of if (= cnt 1)
            (IF (= CNT 2)
              (progn
                (SETQ ISe E1
                      IB  IA
                      IA  E1
                ) ;_ SETQ
              ) ;_ progn
            )                           ;End of if (= cnt 2)
            (IF (> CNT 2)
              (PROGN
                (SETQ IB IA
                      IA E1
                ) ;_ SETQ
              )                         ;End of progn for if (= cnt 1)
            ) ;_ IF
            (isoarc e1 (+ D2 *#iso_offset))
          ) ;_ progn
        ) ;_ if
        (if (= (dxf 0 e) "LINE")
          (progn
            (IF (= CNT 1)
              (progn
                (SETQ IA  E1
                      IFi IA
                ) ;_ SETQ
              ) ;_ progn
            )                           ;End of if (= cnt 1)
            (IF (= CNT 2)
              (progn
                (SETQ ISe E1
                      IB  IA
                      IA  E1
                ) ;_ SETQ
              ) ;_ progn
            )                           ;End of if (= cnt 2)
            (IF (> CNT 2)
              (PROGN
                (SETQ IB IA
                      IA E1
                ) ;_ SETQ
              )                         ;End of progn for if (= cnt 1)
            ) ;_ IF
            (setq pt1 (dxf 10 e))
            (setq pt2 (dxf 11 e))
            (setq A1 (angle (dxf 10 e) (dxf 11 e)))
            (isoline PT1 PT2 (- A1 1.5707963) (+ D2 *#iso_offset))
            (isoline PT1 PT2 (+ A1 1.5707963) (+ D2 *#iso_offset))
          ) ;_ progn
        ) ;_ if
      ) ;_ progn
    ) ;_ if
    (command "_undo" "_end")
    (setq CNT (1+ CNT))
  ) ;_ while
  ;;###################################################
  (IF (and IFi ISe)
    (progn
      (INITGET "ja nein Ja Nein JA NEIN")
      (SETQ YN
             (GETKWORD
               "\nAnfang u. Ende der Isolierung abschließen? (Ja/Nein) <JA>: "
             ) ;_ GETKWORD
      ) ;_ SETQ
      (IF (NOT YN)
        (SETQ YN "JA")
        (SETQ YN (STRCASE YN))
      ) ;_ IF
    ) ;_ progn
  ) ;_ IF
  (IF (and (= YN "JA") IFi ISe)
    (progn
      ;;------------------------ IFi ---------------------------------
      (if (and IFi (= (dxf 0 (entget IFi)) "ARC"))
        (progn
          (setq lst (arc_s_e IFi))
          (setq cf (nth 0 lst))
          (setq afps (nth 1 lst))
          (setq afpe (nth 2 lst))
        ) ;_ progn
      ) ;_ if
      (if (and IFi (= (dxf 0 (entget IFi)) "LINE"))
        (progn
          (setq e (entget IFi))
          (setq lfp10 (dxf 10 e))
          (setq lfp11 (dxf 11 e))
        ) ;_ progn
      ) ;_ if
      ;;------------------------ ISe ---------------------------------
      (if (and ISe (= (dxf 0 (entget ISe)) "ARC"))
        (progn
          (setq lst (arc_s_e ISe))
          (setq cs (nth 0 lst))
          (setq asps (nth 1 lst))
          (setq aspe (nth 2 lst))
        ) ;_ progn
      ) ;_ if
      (if (and ISe (= (dxf 0 (entget ISe)) "LINE"))
        (progn
          (setq e (entget ISe))
          (setq lsp10 (dxf 10 e))
          (setq lsp11 (dxf 11 e))
        ) ;_ progn
      ) ;_ if
      ;;------------------------ IA ----------------------------------
      (if (and IA (= (dxf 0 (entget IA)) "ARC"))
        (progn
          (setq lst (arc_s_e IA))
          (setq ca (nth 0 lst))
          (setq aaps (nth 1 lst))
          (setq aape (nth 2 lst))
        ) ;_ progn
      ) ;_ if
      (if (and IA (= (dxf 0 (entget IA)) "LINE"))
        (progn
          (setq e (entget IA))
          (setq lap10 (dxf 10 e))
          (setq lap11 (dxf 11 e))
        ) ;_ progn
      ) ;_ if
      ;;------------------------ IB ----------------------------------
      (if (and IB (= (dxf 0 (entget IB)) "ARC"))
        (progn
          (setq lst (arc_s_e IB))
          (setq cb (nth 0 lst))
          (setq abps (nth 1 lst))
          (setq abpe (nth 2 lst))
        ) ;_ progn
      ) ;_ if
      (if (and IB (= (dxf 0 (entget IB)) "LINE"))
        (progn
          (setq e (entget IB))
          (setq lbp10 (dxf 10 e))
          (setq lbp11 (dxf 11 e))
        ) ;_ progn
      ) ;_ if
      ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
      (command "_color" "_bylayer" "_-linetype" "_se" "verdecktx2" "") ;_ command
      ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
      (if (and
            IFi
            ISe
            (= (dxf 0 (entget IFi)) "LINE")
            (= (dxf 0 (entget ISe)) "LINE")
          ) ;_ and
        (progn
          (if (or (equal lfp11 lsp10) (equal lfp11 lsp11))
            (progn
              (if (equal lfp11 lsp10)
                (setq anfp lfp10)
                (setq anfp lfp11)
              ) ;_ if
              (setq A1 (angle lfp10 lfp11))
              (command "_line"
                       (polar anfp (- A1 (/ pi 2)) (+ D2 *#iso_offset))
                       (polar anfp (- A1 (/ pi 2)) D2)
                       ""
              ) ;_ command
              (command "_line"
                       (polar anfp (+ A1 (/ pi 2)) (+ D2 *#iso_offset))
                       (polar anfp (+ A1 (/ pi 2)) D2)
                       ""
              ) ;_ command
            ) ;_ progn
            (princ "\rIsolation wurde nicht geschlossen.")
          ) ;_ if
        ) ;_ progn
        ;;
      )                                 ;
      ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
      (if (and
            IFi
            ISe
            (= (dxf 0 (entget IFi)) "ARC")
            (= (dxf 0 (entget ISe)) "LINE")
          ) ;_ and
        (progn
          (if (or
                (equal afps lsp10 0.001)
                (equal afps lsp11 0.001)
                (equal afpe lsp10 0.001)
                (equal afpe lsp11 0.001)
              ) ;_ or
            (progn
              (if
                (or (equal afps lsp10 0.001) (equal afps lsp11 0.001))
                 (setq anfp afpe)
                 (setq anfp afps)
              ) ;_ if
              (setq A1 (+ (angle cf anfp) (/ pi 2)))
              (command "_line"
                       (polar anfp (- A1 (/ pi 2)) (+ D2 *#iso_offset))
                       (polar anfp (- A1 (/ pi 2)) D2)
                       ""
              ) ;_ command
              (command "_line"
                       (polar anfp (+ A1 (/ pi 2)) (+ D2 *#iso_offset))
                       (polar anfp (+ A1 (/ pi 2)) D2)
                       ""
              ) ;_ command
            ) ;_ progn
            (princ "\rIsolation wurde nicht geschlossen..")
          ) ;_ if
        ) ;_ progn
        ;;
      )                                 ;
      ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
      (if (and
            IFi
            ISe
            (= (dxf 0 (entget IFi)) "LINE")
            (= (dxf 0 (entget ISe)) "ARC")
          ) ;_ and
        (progn
          (if (or
                (equal lfp10 asps 0.001)
                (equal lfp10 aspe 0.001)
                (equal lfp11 asps 0.001)
                (equal lfp11 aspe 0.001)
              ) ;_ or
            (progn
              (if (or
                    (equal lfp10 asps 0.001)
                    (equal lfp10 aspe 0.001)
                  ) ;_ or
                (setq anfp lfp11)
              ) ;_ if
              (if (or
                    (equal lfp11 asps 0.001)
                    (equal lfp11 aspe 0.001)
                  ) ;_ or
                (setq anfp lfp10)
              ) ;_ if
              (setq A1 (angle lfp10 lfp11))
              (command "_line"
                       (polar anfp (- A1 (/ pi 2)) (+ D2 *#iso_offset))
                       (polar anfp (- A1 (/ pi 2)) D2)
                       ""
              ) ;_ command
              (command "_line"
                       (polar anfp (+ A1 (/ pi 2)) (+ D2 *#iso_offset))
                       (polar anfp (+ A1 (/ pi 2)) D2)
                       ""
              ) ;_ command
            ) ;_ progn
            (princ "\rIsolation wurde nicht geschlossen...")
          ) ;_ if
        ) ;_ progn
        ;;
      )                                 ;
      ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
      (if (and
            IFi
            ISe
            (= (dxf 0 (entget IFi)) "ARC")
            (= (dxf 0 (entget ISe)) "ARC")
          ) ;_ and
        (progn
          (if (or
                (equal afps asps 0.001)
                (equal afps aspe 0.001)
                (equal afpe asps 0.001)
                (equal afpe aspe 0.001)
              ) ;_ or
            (progn
              (if (equal afps asps 0.001)
                (setq anfp afpe)
              ) ;_ if
              (if (equal afps aspe 0.001)
                (setq anfp afpe)
              ) ;_ if
              (if (equal afpe asps 0.001)
                (setq anfp afps)
              ) ;_ if
              (if (equal afpe aspe 0.001)
                (setq anfp afps)
              ) ;_ if
              (setq A1 (+ (angle cf anfp) (/ pi 2)))
              (command "_line"
                       (polar anfp (- A1 (/ pi 2)) (+ D2 *#iso_offset))
                       (polar anfp (- A1 (/ pi 2)) D2)
                       ""
              ) ;_ command
              (command "_line"
                       (polar anfp (+ A1 (/ pi 2)) (+ D2 *#iso_offset))
                       (polar anfp (+ A1 (/ pi 2)) D2)
                       ""
              ) ;_ command
            ) ;_ progn
            (princ "\rIsolation wurde nicht geschlossen....")
          ) ;_ if
        ) ;_ progn
        ;;
      )                                 ;
      ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
      ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
      (if (and
            IA
            IB
            (= (dxf 0 (entget IA)) "ARC")
            (= (dxf 0 (entget IB)) "ARC")
          ) ;_ and
        (progn
          (if (or
                (equal aaps abps 0.001)
                (equal aaps abpe 0.001)
                (equal aape abps 0.001)
                (equal aape abpe 0.001)
              ) ;_ or
            (progn
              (if (equal aaps abps 0.001)
                (setq anfp aape)
              ) ;_ if
              (if (equal aaps abpe 0.001)
                (setq anfp aape)
              ) ;_ if
              (if (equal aape abps 0.001)
                (setq anfp aaps)
              ) ;_ if
              (if (equal aape abpe 0.001)
                (setq anfp aaps)
              ) ;_ if
              (setq A1 (+ (angle ca anfp) (/ pi 2)))
              (command "_line"
                       (polar anfp (- A1 (/ pi 2)) (+ D2 *#iso_offset))
                       (polar anfp (- A1 (/ pi 2)) D2)
                       ""
              ) ;_ command
              (command "_line"
                       (polar anfp (+ A1 (/ pi 2)) (+ D2 *#iso_offset))
                       (polar anfp (+ A1 (/ pi 2)) D2)
                       ""
              ) ;_ command
            ) ;_ progn
            (princ "\rIsolation wurde nicht geschlossen.....")
          ) ;_ if
        ) ;_ progn
        ;;
      )                                 ;
      ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
      (if (and
            IA
            IB
            (= (dxf 0 (entget IA)) "LINE")
            (= (dxf 0 (entget IB)) "LINE")
          ) ;_ and
        (progn
          (if (or
                (equal lap11 lbp10)
                (equal lap11 lbp11)
                (equal lap10 lbp10)
                (equal lap10 lbp11)
              ) ;_ or
            (progn
              (if (equal lap11 lbp10)
                (setq anfp lap10)
                (setq anfp lap11)
              ) ;_ if
              (setq A1 (angle lap10 lap11))
              (command "_line"
                       (polar anfp (- A1 (/ pi 2)) (+ D2 *#iso_offset))
                       (polar anfp (- A1 (/ pi 2)) D2)
                       ""
              ) ;_ command
              (command "_line"
                       (polar anfp (+ A1 (/ pi 2)) (+ D2 *#iso_offset))
                       (polar anfp (+ A1 (/ pi 2)) D2)
                       ""
              ) ;_ command
            ) ;_ progn
            (princ "\rIsolation wurde nicht geschlossen......")
          ) ;_ if
        ) ;_ progn
        ;;
      )                                 ;
      ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
      (if (and
            IB
            IA
            (= (dxf 0 (entget IB)) "LINE")
            (= (dxf 0 (entget IA)) "ARC")
          ) ;_ and
        (progn
          (if (or
                (equal lbp10 aaps 0.001)
                (equal lbp10 aape 0.001)
                (equal lbp11 aaps 0.001)
                (equal lbp11 aape 0.001)
              ) ;_ or
            (progn
              (if (or
                    (equal lbp10 aaps 0.001)
                    (equal lbp11 aaps 0.001)
                  ) ;_ or
                (setq anfp aape)
                (setq anfp aaps)
              ) ;_ if
              (setq A1 (+ (angle ca anfp) (/ pi 2)))
              (command "_line"
                       (polar anfp (- A1 (/ pi 2)) (+ D2 *#iso_offset))
                       (polar anfp (- A1 (/ pi 2)) D2)
                       ""
              ) ;_ command
              (command "_line"
                       (polar anfp (+ A1 (/ pi 2)) (+ D2 *#iso_offset))
                       (polar anfp (+ A1 (/ pi 2)) D2)
                       ""
              ) ;_ command
            ) ;_ progn
            (princ "\rIsolation wurde nicht geschlossen.......")
          ) ;_ if
        ) ;_ progn
        ;;
      )                                 ;
      ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
      (if (and
            IB
            IA
            (= (dxf 0 (entget IB)) "ARC")
            (= (dxf 0 (entget IA)) "LINE")
          ) ;_ and
        (progn
          (if (or
                (equal abps lap10 0.001)
                (equal abps lap11 0.001)
                (equal abpe lap10 0.001)
                (equal abpe lap11 0.001)
              ) ;_ or
            (progn
              (if (or
                    (equal abps lap10 0.001)
                    (equal abpe lap10 0.001)
                  ) ;_ or
                (setq anfp lap11)
                (setq anfp lap10)
              ) ;_ if
              (setq A1 (angle lap10 lap11))
              (command "_line"
                       (polar anfp (- A1 (/ pi 2)) (+ D2 *#iso_offset))
                       (polar anfp (- A1 (/ pi 2)) D2)
                       ""
              ) ;_ command
              (command "_line"
                       (polar anfp (+ A1 (/ pi 2)) (+ D2 *#iso_offset))
                       (polar anfp (+ A1 (/ pi 2)) D2)
                       ""
              ) ;_ command
            ) ;_ progn
            (princ "\rIsolation wurde nicht geschlossen........")
          ) ;_ if
        ) ;_ progn
        ;;
      )                                 ;
      ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
      (command "_color" "_bylayer" "_-linetype" "_se" "_bylayer" "") ;_ command
    ) ;_ progn
  ) ;_ if
  (moder)
) ;_ defun

;;; ------------------ Iso-Linien zeichnen 2 ---------------|
(defun isol2 ( DN D D2 R SS1 / A A1 AANG AAPE AAPS ABPE ABPS AFPE AFPS
            ANFP ANGLE1 ANGLE2 AP10 AP11 arc_last ASPE ASPS B CA CB CF
            CNT CS E E1 flag i IA IB IFi ISe LAP10 LAP11 LBP10 LBP11
            LFP10 LFP11 LSP10 LSP11 LST n PT1 PT2 yn
         )
  (if (> *#iso_offset 0)
    (progn
      (setq n (sslength ss1))
      (setq i 0)
      (SETQ CNT 1)
      (repeat n
        (setq e1 (ssname ss1 i))
        (command "_undo" "_begin")
        (setq e (entget e1))
        (if (= (dxf 0 e) "ARC")
          (progn
            (IF (= CNT 1)
              (progn
                (SETQ IA  E1
                      IFi IA
                ) ;_ SETQ
              ) ;_ progn
            )                           ;End of if (= cnt 1)
            (IF (= CNT 2)
              (progn
                (SETQ ISe E1
                      IB  IA
                      IA  E1
                ) ;_ SETQ
              ) ;_ progn
            )                           ;End of if (= cnt 2)
            (IF (> CNT 2)
              (PROGN
                (SETQ IB IA
                      IA E1
                ) ;_ SETQ
              )                         ;End of progn for if (= cnt 1)
            ) ;_ IF
            (isoarc e1 (+ D2 *#iso_offset))
          ) ;_ progn
        ) ;_ if
        (if (= (dxf 0 e) "LINE")
          (progn
            (IF (= CNT 1)
              (progn
                (SETQ IA  E1
                      IFi IA
                ) ;_ SETQ
              ) ;_ progn
            )                           ;End of if (= cnt 1)
            (IF (= CNT 2)
              (progn
                (SETQ ISe E1
                      IB  IA
                      IA  E1
                ) ;_ SETQ
              ) ;_ progn
            )                           ;End of if (= cnt 2)
            (IF (> CNT 2)
              (PROGN
                (SETQ IB IA
                      IA E1
                ) ;_ SETQ
              )                         ;End of progn for if (= cnt 1)
            ) ;_ IF
            (setq pt1 (dxf 10 e))
            (setq pt2 (dxf 11 e))
            (setq A1 (angle (dxf 10 e) (dxf 11 e)))
            (isoline PT1 PT2 (- A1 1.5707963) (+ D2 *#iso_offset))
            (isoline PT1 PT2 (+ A1 1.5707963) (+ D2 *#iso_offset))
          ) ;_ progn
        ) ;_ if
        (command "_undo" "_end")
        (setq CNT (1+ CNT))
        (setq i (1+ i))
      ) ;_ repeat
      ;;###################################################
      (IF (and IFi ISe)
        (progn
          (INITGET "ja nein Ja Nein JA NEIN")
          (SETQ YN
                 (GETKWORD
                   "\nAnfang u. Ende der Isolierung abschließen? (Ja/Nein) <JA>: "
                 ) ;_ GETKWORD
          ) ;_ SETQ
          (IF (NOT YN)
            (SETQ YN "JA")
            (SETQ YN (STRCASE YN))
          ) ;_ IF
        ) ;_ progn
      ) ;_ IF
      (IF (and (= YN "JA") IFi ISe)
        (progn
          ;;------------------------ IFi ---------------------------------
          (if (and IFi (= (dxf 0 (entget IFi)) "ARC"))
            (progn
              (setq lst (arc_s_e IFi))
              (setq cf (nth 0 lst))
              (setq afps (nth 1 lst))
              (setq afpe (nth 2 lst))
            ) ;_ progn
          ) ;_ if
          (if (and IFi (= (dxf 0 (entget IFi)) "LINE"))
            (progn
              (setq e (entget IFi))
              (setq lfp10 (dxf 10 e))
              (setq lfp11 (dxf 11 e))
            ) ;_ progn
          ) ;_ if
          ;;------------------------ ISe ---------------------------------
          (if (and ISe (= (dxf 0 (entget ISe)) "ARC"))
            (progn
              (setq lst (arc_s_e ISe))
              (setq cs (nth 0 lst))
              (setq asps (nth 1 lst))
              (setq aspe (nth 2 lst))
            ) ;_ progn
          ) ;_ if
          (if (and ISe (= (dxf 0 (entget ISe)) "LINE"))
            (progn
              (setq e (entget ISe))
              (setq lsp10 (dxf 10 e))
              (setq lsp11 (dxf 11 e))
            ) ;_ progn
          ) ;_ if
          ;;------------------------ IA ----------------------------------
          (if (and IA (= (dxf 0 (entget IA)) "ARC"))
            (progn
              (setq lst (arc_s_e IA))
              (setq ca (nth 0 lst))
              (setq aaps (nth 1 lst))
              (setq aape (nth 2 lst))
            ) ;_ progn
          ) ;_ if
          (if (and IA (= (dxf 0 (entget IA)) "LINE"))
            (progn
              (setq e (entget IA))
              (setq lap10 (dxf 10 e))
              (setq lap11 (dxf 11 e))
            ) ;_ progn
          ) ;_ if
          ;;------------------------ IB ----------------------------------
          (if (and IB (= (dxf 0 (entget IB)) "ARC"))
            (progn
              (setq lst (arc_s_e IB))
              (setq cb (nth 0 lst))
              (setq abps (nth 1 lst))
              (setq abpe (nth 2 lst))
            ) ;_ progn
          ) ;_ if
          (if (and IB (= (dxf 0 (entget IB)) "LINE"))
            (progn
              (setq e (entget IB))
              (setq lbp10 (dxf 10 e))
              (setq lbp11 (dxf 11 e))
            ) ;_ progn
          ) ;_ if
          ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
          (command "_color"      "_bylayer"    "_-linetype"
                   "_se"         "verdecktx2"  ""
                  ) ;_ command
          ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
          (if (and
                IFi
                ISe
                (= (dxf 0 (entget IFi)) "LINE")
                (= (dxf 0 (entget ISe)) "LINE")
              ) ;_ and
            (progn
              (if (or (equal lfp11 lsp10) (equal lfp11 lsp11))
                (progn
                  (if (equal lfp11 lsp10)
                    (setq anfp lfp10)
                    (setq anfp lfp11)
                  ) ;_ if
                  (setq A1 (angle lfp10 lfp11))
                  (command
                    "_line"
                    (polar anfp (- A1 (/ pi 2)) (+ D2 *#iso_offset))
                    (polar anfp (- A1 (/ pi 2)) D2)
                    ""
                  ) ;_ command
                  (command
                    "_line"
                    (polar anfp (+ A1 (/ pi 2)) (+ D2 *#iso_offset))
                    (polar anfp (+ A1 (/ pi 2)) D2)
                    ""
                  ) ;_ command
                ) ;_ progn
                (princ "\rIsolation wurde nicht geschlossen.")
              ) ;_ if
            ) ;_ progn
            ;;
          )                             ;
          ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
          (if (and
                IFi
                ISe
                (= (dxf 0 (entget IFi)) "ARC")
                (= (dxf 0 (entget ISe)) "LINE")
              ) ;_ and
            (progn
              (if (or
                    (equal afps lsp10 0.001)
                    (equal afps lsp11 0.001)
                    (equal afpe lsp10 0.001)
                    (equal afpe lsp11 0.001)
                  ) ;_ or
                (progn
                  (if
                    (or (equal afps lsp10 0.001)
                        (equal afps lsp11 0.001)
                    ) ;_ or
                     (setq anfp afpe)
                     (setq anfp afps)
                  ) ;_ if
                  (setq A1 (+ (angle cf anfp) (/ pi 2)))
                  (command
                    "_line"
                    (polar anfp (- A1 (/ pi 2)) (+ D2 *#iso_offset))
                    (polar anfp (- A1 (/ pi 2)) D2)
                    ""
                  ) ;_ command
                  (command
                    "_line"
                    (polar anfp (+ A1 (/ pi 2)) (+ D2 *#iso_offset))
                    (polar anfp (+ A1 (/ pi 2)) D2)
                    ""
                  ) ;_ command
                ) ;_ progn
                (princ "\rIsolation wurde nicht geschlossen..")
              ) ;_ if
            ) ;_ progn
            ;;
          ) ;_ if
          ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
          (if (and
                IFi
                ISe
                (= (dxf 0 (entget IFi)) "LINE")
                (= (dxf 0 (entget ISe)) "ARC")
              ) ;_ and
            (progn
              (if (or
                    (equal lfp10 asps 0.001)
                    (equal lfp10 aspe 0.001)
                    (equal lfp11 asps 0.001)
                    (equal lfp11 aspe 0.001)
                  ) ;_ or
                (progn
                  (if (or
                        (equal lfp10 asps 0.001)
                        (equal lfp10 aspe 0.001)
                      ) ;_ or
                    (setq anfp lfp11)
                  ) ;_ if
                  (if (or
                        (equal lfp11 asps 0.001)
                        (equal lfp11 aspe 0.001)
                      ) ;_ or
                    (setq anfp lfp10)
                  ) ;_ if
                  (setq A1 (angle lfp10 lfp11))
                  (command
                    "_line"
                    (polar anfp (- A1 (/ pi 2)) (+ D2 *#iso_offset))
                    (polar anfp (- A1 (/ pi 2)) D2)
                    ""
                  ) ;_ command
                  (command
                    "_line"
                    (polar anfp (+ A1 (/ pi 2)) (+ D2 *#iso_offset))
                    (polar anfp (+ A1 (/ pi 2)) D2)
                    ""
                  ) ;_ command
                ) ;_ progn
                (princ "\rIsolation wurde nicht geschlossen...")
              ) ;_ if
            ) ;_ progn
            ;;
          ) ;_ if
          ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
          (if (and
                IFi
                ISe
                (= (dxf 0 (entget IFi)) "ARC")
                (= (dxf 0 (entget ISe)) "ARC")
              ) ;_ and
            (progn
              (if (or
                    (equal afps asps 0.001)
                    (equal afps aspe 0.001)
                    (equal afpe asps 0.001)
                    (equal afpe aspe 0.001)
                  ) ;_ or
                (progn
                  (if (equal afps asps 0.001)
                    (setq anfp afpe)
                  ) ;_ if
                  (if (equal afps aspe 0.001)
                    (setq anfp afpe)
                  ) ;_ if
                  (if (equal afpe asps 0.001)
                    (setq anfp afps)
                  ) ;_ if
                  (if (equal afpe aspe 0.001)
                    (setq anfp afps)
                  ) ;_ if
                  (setq A1 (+ (angle cf anfp) (/ pi 2)))
                  (command
                    "_line"
                    (polar anfp (- A1 (/ pi 2)) (+ D2 *#iso_offset))
                    (polar anfp (- A1 (/ pi 2)) D2)
                    ""
                  ) ;_ command
                  (command
                    "_line"
                    (polar anfp (+ A1 (/ pi 2)) (+ D2 *#iso_offset))
                    (polar anfp (+ A1 (/ pi 2)) D2)
                    ""
                  ) ;_ command
                ) ;_ progn
                (princ "\rIsolation wurde nicht geschlossen....")
              ) ;_ if
            ) ;_ progn
            ;;
          ) ;_ if
          ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
          ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
          (if (and
                IA
                IB
                (= (dxf 0 (entget IA)) "ARC")
                (= (dxf 0 (entget IB)) "ARC")
              ) ;_ and
            (progn
              (if (or
                    (equal aaps abps 0.001)
                    (equal aaps abpe 0.001)
                    (equal aape abps 0.001)
                    (equal aape abpe 0.001)
                  ) ;_ or
                (progn
                  (if (equal aaps abps 0.001)
                    (setq anfp aape)
                  ) ;_ if
                  (if (equal aaps abpe 0.001)
                    (setq anfp aape)
                  ) ;_ if
                  (if (equal aape abps 0.001)
                    (setq anfp aaps)
                  ) ;_ if
                  (if (equal aape abpe 0.001)
                    (setq anfp aaps)
                  ) ;_ if
                  (setq A1 (+ (angle ca anfp) (/ pi 2)))
                  (command
                    "_line"
                    (polar anfp (- A1 (/ pi 2)) (+ D2 *#iso_offset))
                    (polar anfp (- A1 (/ pi 2)) D2)
                    ""
                  ) ;_ command
                  (command
                    "_line"
                    (polar anfp (+ A1 (/ pi 2)) (+ D2 *#iso_offset))
                    (polar anfp (+ A1 (/ pi 2)) D2)
                    ""
                  ) ;_ command
                ) ;_ progn
                (princ "\rIsolation wurde nicht geschlossen.....")
              ) ;_ if
            ) ;_ progn
            ;;
          ) ;_ if
          ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
          (if (and
                IA
                IB
                (= (dxf 0 (entget IA)) "LINE")
                (= (dxf 0 (entget IB)) "LINE")
              ) ;_ and
            (progn
              (if (or
                    (equal lap11 lbp10)
                    (equal lap11 lbp11)
                    (equal lap10 lbp10)
                    (equal lap10 lbp11)
                  ) ;_ or
                (progn
                  (if (equal lap11 lbp10)
                    (setq anfp lap10)
                    (setq anfp lap11)
                  ) ;_ if
                  (setq A1 (angle lap10 lap11))
                  (command
                    "_line"
                    (polar anfp (- A1 (/ pi 2)) (+ D2 *#iso_offset))
                    (polar anfp (- A1 (/ pi 2)) D2)
                    ""
                  ) ;_ command
                  (command
                    "_line"
                    (polar anfp (+ A1 (/ pi 2)) (+ D2 *#iso_offset))
                    (polar anfp (+ A1 (/ pi 2)) D2)
                    ""
                  ) ;_ command
                ) ;_ progn
                (princ "\rIsolation wurde nicht geschlossen......")
              ) ;_ if
            ) ;_ progn
            ;;
          ) ;_ if
          ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
          (if (and
                IB
                IA
                (= (dxf 0 (entget IB)) "LINE")
                (= (dxf 0 (entget IA)) "ARC")
              ) ;_ and
            (progn
              (if (or
                    (equal lbp10 aaps 0.001)
                    (equal lbp10 aape 0.001)
                    (equal lbp11 aaps 0.001)
                    (equal lbp11 aape 0.001)
                  ) ;_ or
                (progn
                  (if (or
                        (equal lbp10 aaps 0.001)
                        (equal lbp11 aaps 0.001)
                      ) ;_ or
                    (setq anfp aape)
                    (setq anfp aaps)
                  ) ;_ if
                  (setq A1 (+ (angle ca anfp) (/ pi 2)))
                  (command
                    "_line"
                    (polar anfp (- A1 (/ pi 2)) (+ D2 *#iso_offset))
                    (polar anfp (- A1 (/ pi 2)) D2)
                    ""
                  ) ;_ command
                  (command
                    "_line"
                    (polar anfp (+ A1 (/ pi 2)) (+ D2 *#iso_offset))
                    (polar anfp (+ A1 (/ pi 2)) D2)
                    ""
                  ) ;_ command
                ) ;_ progn
                (princ "\rIsolation wurde nicht geschlossen.......")
              ) ;_ if
            ) ;_ progn
            ;;
          ) ;_ if
          ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
          (if (and
                IB
                IA
                (= (dxf 0 (entget IB)) "ARC")
                (= (dxf 0 (entget IA)) "LINE")
              ) ;_ and
            (progn
              (if (or
                    (equal abps lap10 0.001)
                    (equal abps lap11 0.001)
                    (equal abpe lap10 0.001)
                    (equal abpe lap11 0.001)
                  ) ;_ or
                (progn
                  (if (or
                        (equal abps lap10 0.001)
                        (equal abpe lap10 0.001)
                      ) ;_ or
                    (setq anfp lap11)
                    (setq anfp lap10)
                  ) ;_ if
                  (setq A1 (angle lap10 lap11))
                  (command
                    "_line"
                    (polar anfp (- A1 (/ pi 2)) (+ D2 *#iso_offset))
                    (polar anfp (- A1 (/ pi 2)) D2)
                    ""
                  ) ;_ command
                  (command
                    "_line"
                    (polar anfp (+ A1 (/ pi 2)) (+ D2 *#iso_offset))
                    (polar anfp (+ A1 (/ pi 2)) D2)
                    ""
                  ) ;_ command
                ) ;_ progn
                (princ "\rIsolation wurde nicht geschlossen........")
              ) ;_ if
            ) ;_ progn
            ;;
          ) ;_ if
          ;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
          (command "_color" "_bylayer" "_-linetype" "_se" "_bylayer" "") ;_ command
        ) ;_ progn
      ) ;_ if
    ) ;_ progn
  ) ;_ if

) ;_ defun
;;; ------------------ Linien nachzeichnen -----------------|

(defun linz ( DN D D2 R / A A1 AANG ANGLE1 ANGLE2 ANS AP10 AP11
            arc_last B LST ss1
         )
  (if (not *#iso_offset)
    (setq *#iso_offset 0)
  ) ;_ if
  (princ "\n")
  (setvar "osmode" 0)
  (setq SS1 nil)
  (setq ss1 (ssadd))
  (setq A1 'T)
  (while (or (and A B) A1)
    (command "_undo" "_be")
    (setq A1 nil)
    (setq A (car (entsel "\r1. Linie ")))
    (If A
      (progn
        (redraw A 3)
        (setq angle1 (angle (dxf 10 (entget A)) (dxf 11 (entget A))))
      ) ;_ progn
    ) ;_ If
    (setq B (car (entsel "\r2. Linie ")))
    (if B
      (progn
        (redraw B 3)
        (setq angle2 (angle (dxf 10 (entget B)) (dxf 11 (entget B))))
      ) ;_ progn
    ) ;_ if
    (if (and A (not B))
      (setq A1 A)
    ) ;_ if
    (if (and B (not A))
      (setq A1 B)
    ) ;_ if
    (if (and B A)
      (setq A1 A)
    ) ;_ if
    (if (eq B A)
      (setq A1 A)
    ) ;_ if
    (if (and A B (not (eq A B)))
      (progn
        (if (= (acute angle1 angle2) 0.0)
          (progn
            (setq A1 A)
            (redraw B 4)
            (setq B nil)
          ) ;_ progn
        ) ;_ if
      ) ;_ progn
    ) ;_ if
    (if (and A B (not (eq A B)))
      (progn
        (setq lst (arcfill R A B))
        (setq arc_last (entlast))
        (if *#iso_offset
          (progn
            (ssadd A ss1)
            (ssadd arc_last ss1)
          )
        ) ;_ if
      ) ;_ progn
      (setq lst (list nil ""))
    ) ;_ if
    (if (nth 0 lst)
      (progn
        (alert (fillet_err_code (nth 0 lst)))
        (prompt (strcat "\n" (nth 0 lst) "\n"))
        (setq A1 nil)
      ) ;_ progn
      (progn
        (command "_color" "1" "_-linetype" "_se" "mittex2" "")
        (if (/= (nth 1 lst) "")
          (progn
            (command "_change" arc_last "" "_p" "_c" 1 "_lty" "mittex2"
                     "") ;_ command
            (command "_color"     "_bylayer"   "_-linetype"
                     "_se"        "_bylayer"   ""
                    ) ;_ command
            (arc2 arc_last D2)
          ) ;_ progn
        ) ;_ if
        (if A1
          (progn
            (command "_color"     "_bylayer"   "_-linetype"
                     "_se"        "_bylayer"   ""
                    ) ;_ command
            (setq Ap10 (dxf 10 (entget A1)))
            (setq Ap11 (dxf 11 (entget A1)))
            (setq Aang (angle Ap10 Ap11))
            (COMMAND "_LINE"
                     (POLAR Ap10 (+ Aang 1.5707963) D2)
                     (POLAR Ap10 (- Aang 1.5707963) D2)
                     ""
            ) ;_ COMMAND
            (COMMAND "_LINE"
                     (POLAR Ap11 (+ Aang 1.5707963) D2)
                     (POLAR Ap11 (- Aang 1.5707963) D2)
                     ""
            ) ;_ COMMAND
            (command "_offset" D2 "")
            (command "_offset"
                     ""
                     A1
                     (polar Ap10 (+ Aang (* 0.5 pi)) D2)
                     ""
            ) ;_ command
            (command "_change" (entlast) "" "_p" "_c" "_bylayer" "_lty" "_bylayer" "")
            (command "_offset"
                     ""
                     A1
                     (polar Ap10 (- Aang (* 0.5 pi)) D2)
                     ""
            ) ;_ command
            (command "_change" (entlast) "" "_p" "_c" "_bylayer" "_lty" "_bylayer" "")
            (command "_change" A1 "" "_p" "_c" 1 "_lty" "mittex2" "")
            (if *#iso_offset
              (ssadd A1 ss1)
            ) ;_ if
          ) ;_ progn
        ) ;_ if
      ) ;_ progn
    ) ;_ if
    (command "_undo" "_end")
  ) ;_ while
  (setq ans (getstring "Isolation zeichnen <Ja/Nein> ?: <Ja>"))
  (if (or (= ans "") (= ans "j") (= ans "J"))
    (progn
      (setq ans "J")
      (c:iso)
    )
    (setq ans "N")
  )
  (if (and (= ans "J") (> *#iso_offset 0))
    (isol2 DN D D2 R SS1)
    (setq SS1 nil)
  ) ;_ if
) ;_ defun

;;;---------- Rohrleitung fortlaufend zeichnen -------------|

(DEFUN Rohrltg ( DN D D2 R WI / A A1 B BP1 BP2 BP3 BP4 C CHG CNT DIF
            DIS1 DIS2 E1 IL1A IL1B IL1F IL2A IL2B IL2F ISO1 ISO2 ISTA1
            L1A L1B L1F L2A L2B L2F LP LST MA1 MA2 ML1A ML1B ML1F N
            P1F P2F PT0 PT1 PT2 PT3 S1 S2 S3 STA1 STPT STPT1 YN
         )
  (rohr_info DN)
  (setq *#break nil)
  (setvar "osmode" 0)
  (princ (strcat "\nDN "
                 DN
                 " :    Durchmesser = "
                 (rtos D)
                 "   Radius = "
                 (rtos R)
         ) ;_ strcat
  ) ;_ princ
  ;;Get the first from point and to point.
  (SETQ PT1 (GETPOINT "\nVon Punkt: "))
  (if pt1
    (progn
      (SETQ PT2   (GETPOINT PT1 "\rNach Punkt: ")
            STPT1 PT1
            PT0   PT1
      ) ;_ SETQ
      (SETQ CNT 1)
      (WHILE (/= PT2 nil)
        (command "_undo" "_be")
        (SETQ A1 (ANGLE PT1 PT2))
        (if (boundp WI)
          (setq A1 (Winkel A1))
        ) ;_ if
        (setq pt3 (polar pt1 a1 (distance pt1 pt2)))
        (setq pt2 pt3)
        ;;
        (pipeline PT1 PT2 (+ A1 1.5707963) D2)
        (IF (= CNT 1)
          (progn
            (SETQ L1A (ENTLAST)
                  L1F L1A
            ) ;_ SETQ
            (setq STA1 A1)
          ) ;_ progn
          (PROGN
            (SETQ L1B L1A
                  L1A (ENTLAST)
            ) ;_ SETQ
          )                             ;End of progn for if (= cnt 1)
        )                               ;End of if (= cnt 1)
        ;;
        (if (> *#iso_offset 0)
          (progn
            (isoline PT1 PT2 (+ A1 1.5707963) (+ D2 *#iso_offset))
            (IF (= CNT 1)
              (progn
                (SETQ IL1A (ENTLAST)
                      IL1F IL1A
                ) ;_ SETQ
                (setq ISTA1 A1)
              ) ;_ progn
              (PROGN
                (SETQ IL1B IL1A
                      IL1A (ENTLAST)
                ) ;_ SETQ
              )                         ;End of progn for if (= cnt 1)
            )                           ;End of if (= cnt 1)
          ) ;_ progn
        ) ;_ if
        ;;
        (pipeline PT1 PT2 (- A1 1.5707963) D2)
        (IF (= CNT 1)
          (SETQ L2A (ENTLAST)
                L2F L2A
          ) ;_ SETQ
          (PROGN
            (SETQ L2B L2A
                  L2A (ENTLAST)
            ) ;_ SETQ
          )                             ;End of progn for if (= cnt 1)
        )                               ;End of if (= cnt 1)
        ;;
        (if (> *#iso_offset 0)
          (progn
            (isoline PT1 PT2 (- A1 1.5707963) (+ D2 *#iso_offset))
            (IF (= CNT 1)
              (SETQ IL2A (ENTLAST)
                    IL2F IL2A
              ) ;_ SETQ
              (PROGN
                (SETQ IL2B IL2A
                      IL2A (ENTLAST)
                ) ;_ SETQ
              )                         ;End of progn for if (= cnt 1)
            )                           ;End of if (= cnt 1)
          ) ;_ progn
        ) ;_ if
        ;;--------------------------------------------------#
        (command "_color" "1" "_-linetype" "_se" "mittex2" "")
        (COMMAND "_LINE"
                 (POLAR PT1 (* A1 1.5707963) 0.0)
                 (POLAR PT2 (* A1 1.5707963) 0.0)
                 ""
        ) ;_ COMMAND
        (IF (= CNT 1)
          (progn
            (SETQ ML1A (ENTLAST)
                  ML1F ML1A
                  p1f  (POLAR PT1 (* A1 1.5707963) 0.0)
                  p2f  (POLAR PT2 (* A1 1.5707963) 0.0)
            ) ;_ SETQ
          ) ;_ progn
          (progn
            (SETQ ML1B ML1A
                  ML1A (ENTLAST)
            ) ;_ SETQ
            (setq ma1 (angle pt0 pt1))
            (setq ma2 (angle pt1 pt2))
            ;; Endpunkte der Bogen-Sehne ermitteln
            (setq s1 (polar pt1 (angle pt1 pt0) R))
            (setq s2 (polar pt1 (angle pt1 pt2) R))
            (if (not (equal ma1 ma2 0.001))
              (PROGN
                ;;Sehnenmittelpunkt
                (setq s3 (getmidpt s1 s2))
                ;;Abstände zur Bogensehne finden
                (setq
                  dis1 (distance (POLAR PT2 (+ A1 1.5707963) D2) s3)
                ) ;_ setq
                (setq
                  dis2 (distance (POLAR PT2 (- A1 1.5707963) D2) s3)
                ) ;_ setq
                ;;Mittel-Linie abrunden
                (setq lst (arcfill R ML1A ML1B)) ; mittlerer Bogen
                (if (/= (nth 0 lst) nil)
                  (progn
                    (alert (fillet_err_code (nth 0 lst)))
                    (prompt (strcat "\n" (nth 0 lst) "\n"))
                    (fillet_undo)
                    (setq pt2 pt1)
                    (setq pt1 pt0)
                    (setq l1a l1b)
                    (setq l2a l2b)
                    (setq il1a il1b)
                    (setq il2a il2b)
                    (setq ml1a ml1b)
                    (setq *#l1a l1a)
                    (setq *#l2a l2a)
                    (setq *#il1a il1a)
                    (setq *#il2a il2a)
                    (setq *#ml1a ml1a)
                  ) ;_ progn
                  (progn
                    (command "_change"
                             (entlast)
                             ""
                             "_p"
                             "_c"
                             1
                             "_lty"
                             "mittex2"
                             ""
                    ) ;_ command
                    ;;
                    (if (> *#iso_offset 0)
                      (progn
                        (if (< dis1 dis2)
                          (setq lst (arcfill (- R D2 *#iso_offset)
                                             IL1A
                                             IL1B
                                    ) ;_ arcfill
                          )             ; iso-Innenbogen
                          (setq lst (arcfill (+ R D2 *#iso_offset)
                                             IL1A
                                             IL1B
                                    ) ;_ arcfill
                          )             ; iso-Aussenbogen
                        ) ;_ if
                        (if (/= (nth 0 lst) nil)
                          (progn
                            (alert (fillet_err_code (nth 0 lst)))
                            (prompt (strcat "\n" (nth 0 lst) "\n"))
                            (fillet_undo)
                            (setq pt2 pt1)
                            (setq pt1 pt0)
                            (setq l1a l1b)
                            (setq l2a l2b)
                            (setq il1a il1b)
                            (setq il2a il2b)
                            (setq ml1a ml1b)
                            (setq *#l1a l1a)
                            (setq *#l2a l2a)
                            (setq *#il1a il1a)
                            (setq *#il2a il2a)
                            (setq *#ml1a ml1a)
                          ) ;_ progn
                        ) ;_ if
                        (command "_change"
                                 (entlast)
                                 ""
                                 "_p"
                                 "_c"
                                 "_bylayer"
                                 "_lty"
                                 "verdecktx2"
                                 ""
                        ) ;_ command
                        (if (< dis1 dis2)
                          (setq lst (arcfill (+ R D2 *#iso_offset)
                                             IL2A
                                             IL2B
                                    ) ;_ arcfill
                          )             ; iso-Aussenbogen
                          (setq lst (arcfill (- R D2 *#iso_offset)
                                             IL2A
                                             IL2B
                                    ) ;_ arcfill
                          )             ; iso-Innenbogen
                        ) ;_ if
                        (if (/= (nth 0 lst) nil)
                          (progn
                            (alert (fillet_err_code (nth 0 lst)))
                            (prompt (strcat "\n" (nth 0 lst) "\n"))
                            (fillet_undo)
                            (setq pt2 pt1)
                            (setq pt1 pt0)
                            (setq l1a l1b)
                            (setq l2a l2b)
                            (setq il1a il1b)
                            (setq il2a il2b)
                            (setq ml1a ml1b)
                            (setq *#l1a l1a)
                            (setq *#l2a l2a)
                            (setq *#il1a il1a)
                            (setq *#il2a il2a)
                            (setq *#ml1a ml1a)
                          ) ;_ progn
                        ) ;_ if
                        (command "_change"
                                 (entlast)
                                 ""
                                 "_p"
                                 "_c"
                                 "_bylayer"
                                 "_lty"
                                 "verdecktx2"
                                 ""
                        ) ;_ command
                      ) ;_ progn
                    ) ;_ if
                    ;;
                    (command "_color"     "_bylayer"   "_-linetype"
                             "_se"        "_bylayer"   ""
                            ) ;_ command
                    (if (< dis1 dis2)
                      (arcfill (- R (/ D 2.0)) L1A L1B) ; Innenbogen
                      (arcfill (+ R (/ D 2.0)) L1A L1B) ; Aussenbogen
                    ) ;_ if
                    ;;Bogen-Endpunkte ermitteln
                    (setq e1 (entget (entlast)))
                    (setq a (dxf 10 e1) ;the center point
                          b (dxf 40 e1) ;the radius
                          n (dxf 50 e1) ;the start angle
                          c (dxf 51 e1) ;the end angle
                    )                   ;setq
                    (setq bp1 (polar a n b))
                    (setq bp2 (polar a c b))
                    (if (< dis1 dis2)
                      (arcfill (+ R (/ D 2.0)) L2A L2B) ; Innenbogen
                      (arcfill (- R (/ D 2.0)) L2A L2B) ; Aussenbogen
                    ) ;_ if
                    ;;Bogen-Endpunkte ermitteln
                    (setq e1 (entget (entlast)))
                    (setq a (dxf 10 e1) ;the center point
                          b (dxf 40 e1) ;the radius
                          n (dxf 50 e1) ;the start angle
                          c (dxf 51 e1) ;the end angle
                    )                   ;setq
                    (setq bp3 (polar a n b))
                    (setq bp4 (polar a c b))
                    ;;Bogenwinkel
                    (if (> c n)
                      (setq CHG (- c n));diff in start ang/end angle if END is greater
                      (setq CHG (abs (- (- n c) (* 2 pi))))
                                        ;diff in start ang/end angle if STR is greater
                    ) ;_ if
                    (setq DIF (rtd CHG)) ;CHG converted to degrees
                    (command "_line" bp1 bp3 "") ; Bogen-Abschluß
                    (command "_line" bp2 bp4 "") ; Bogen-Abschluß
                    (prompt (strcat "\nWinkel des letzten Bogens: "
                                    (rtos DIF)
                                    "°\n"
                            ) ;_ strcat
                    ) ;_ prompt
                  ) ;_ progn
                ) ;_ if
              ) ;_ PROGN
            ) ;_ if
          )                             ;End of progn for if (= cnt 0)
        )                               ;End of if (= cnt 0)
        (command "_undo" "_end")
        (SETQ pt0 pt1
              PT1 PT2
              PT2 (GETPOINT PT1 "\rNach Punkt: ")
              CNT (1+ CNT)
        ) ;_ SETQ
        (setvar "lastpoint" pt0)
        (setq DIF nil)
      )                                 ;End of while (/= pt2 nil...)
    ) ;_ progn
    (princ)
  ) ;_ if
  ;;#########################################################
  (if (and (= *#break nil) L1F (= (dxf 0 (entget L1F)) "LINE"))
    (progn
      ;;(INITGET "ja nein Ja Nein JA NEIN")
      ;;(SETQ YN
      ;;       (GETKWORD
      ;;         "\nAnfang der Rohrleitung abschließen? (<Ja>/Nein) <Nein>: "
      ;;       ) ;_ GETKWORD
      ;;) ;_ SETQ
      (setq YN "JA")
      (IF (NOT YN)
        (SETQ YN "nein")
        (SETQ YN (STRCASE YN))
      ) ;_ IF
      (IF (= YN "JA")
        (if (= "LINE" (dxf 0 (entget L1F)))
          (progn
            (command "_color" "_bylayer" "_-linetype" "_se" "_bylayer" "") ;_ command
            (COMMAND "_LINE"
                     (POLAR STPT1 (+ STA1 1.5707963) D2)
                     (POLAR STPT1 (- STA1 1.5707963) D2)
                     ""
            ) ;_ COMMAND
            (if (> *#iso_offset 0)
              (progn
                (command "_color"      "_bylayer"    "_-linetype"
                         "_se"         "verdecktx2"  ""
                        ) ;_ command
                (setq iso1 (polar STPT1
                                  (+ STA1 1.5707963)
                                  (+ D2 *#iso_offset)
                           ) ;_ polar
                ) ;_ setq
                (setq iso2 (polar STPT1
                                  (- STA1 1.5707963)
                                  (+ D2 *#iso_offset)
                           ) ;_ polar
                ) ;_ setq
                (command "_color"      "_bylayer"    "_-linetype"
                         "_se"         "verdecktx2"  ""
                        ) ;_ command
                (COMMAND "_LINE"
                         iso1
                         (polar iso1 (- STA1 1.5707963) *#iso_offset)
                         ""
                ) ;_ COMMAND
                (COMMAND "_LINE"
                         iso2
                         (polar iso2 (+ STA1 1.5707963) *#iso_offset)
                         ""
                ) ;_ COMMAND
                (command "_color"     "_bylayer"   "_-linetype"
                         "_se"        "_bylayer"   ""
                        ) ;_ command
              ) ;_ progn
            ) ;_ if
          ) ;_ progn
        ) ;_ if
      ) ;_ IF
    ) ;_ progn
  ) ;_ if
  (if (and (= *#break nil) ML1A (= (dxf 0 (entget ML1A)) "LINE"))
    (progn
      (if (not ma2)
        (setq ma2 STA1)
      ) ;_ if
      ;;(INITGET "ja nein Ja Nein JA NEIN")
      ;;(SETQ YN
      ;;       (GETKWORD
      ;;         "\nEnde der Rohrleitung abschließen? (<Ja>/Nein) <Nein>: "
      ;;       ) ;_ GETKWORD
      ;;) ;_ SETQ
      (setq YN "JA")
      (IF (NOT YN)
        (SETQ YN "nein")
        (SETQ YN (STRCASE YN))
      ) ;_ IF
      (IF (= YN "JA")
        (if (= "LINE" (dxf 0 (entget ML1A)))
          (progn
            (command "_color" "_bylayer" "_-linetype" "_se" "_bylayer" "") ;_ command
            (setq lp (dxf 11 (entget ML1A)))
            (COMMAND "_LINE"
                     (POLAR lp (+ ma2 1.5707963) D2)
                     (POLAR lp (- ma2 1.5707963) D2)
                     ""
            ) ;_ COMMAND
            (if (> *#iso_offset 0)
              (progn
                (setq iso1
                       (polar lp (+ ma2 1.5707963) (+ D2 *#iso_offset))
                ) ;_ setq
                (setq iso2
                       (polar lp (- ma2 1.5707963) (+ D2 *#iso_offset))
                ) ;_ setq
                (COMMAND "_LINE"
                         iso1
                         (polar iso1 (- ma2 1.5707963) *#iso_offset)
                         ""
                ) ;_ COMMAND
                (COMMAND "_LINE"
                         iso2
                         (polar iso2 (+ ma2 1.5707963) *#iso_offset)
                         ""
                ) ;_ COMMAND
              ) ;_ progn
            ) ;_ if
          ) ;_ PROGN
        ) ;_ if
      ) ;_ IF
    ) ;_ progn
  ) ;_ if
) ;_ DEFUN

;;; --------------------------------------------------------|
(defun bogf1 ( DN D D2 R / EL EN LST P )
  (SETVAR "cmdecho" 0)
  (setq p (getpoint "\nBogen-Startpunkt: "))
  (if p
    (progn
      (setq lst (list "PUNKT" p ""))
      (bogf lst DN D D2 R)
    ) ;_ progn
    (progn
      (setq EN (entsel "\nBogen- oder Linien-Ende picken: "))
      (if EN
        (progn
          (setq EL (entget (car EN)))
          (setq lst (list (dxf 0 EL) (cadr EN) (car EN)))
          (cond
            ((= (nth 0 lst) "LINE")
             (princ "\n** Linie gefunden")
             ;;(redraw (nth 2 lst) 3)
             (bogl lst DN D D2 R)
             ;;(redraw (nth 2 lst) 4)
            )
            ((= (nth 0 lst) "ARC")
             (princ "\n** Bogen gefunden")
             ;;(redraw (nth 2 lst) 3)
             (bogb lst DN D D2 R)
             ;;(redraw (nth 2 lst) 4)
            )
            ('T
             (alert
               "Falsches Objekt!\n\nBitte Linien- oder Bogen-Ende picken\noder Punkt wählen."
             ) ;_ alert
            )
          ) ;_ cond
        ) ;_ progn
      ) ;_ if
    ) ;_ progn
  ) ;_ if
) ;_ defun
;;; --------------------------------------------------------|

(defun c:BOGB ( / D D2 DN DN_LST R )
  (error_begin)
  (modes)
  (SETVAR "cmdecho" 0)
  (setq DN_lst (DN:NennDurchmesser (setq DN (DN_eingabe))))
  (if DN_lst
    (progn
      (setq D (car DN_lst))
      (setq R (cdr DN_lst))
      (SETQ D2 (/ D 2))
      (rohr_info DN)
      (bogb nil DN D D2 R)
    ) ;_ progn
  ) ;_ if
  (error_end)
  (moder)
  (princ)
) ;_ defun
;;; --------------------------------------------------------|

(defun c:BOGW ( / D D2 DN DN_LST R )
  (error_begin)
  (modes)
  (SETVAR "cmdecho" 0)
  (setq DN_lst (DN:NennDurchmesser (setq DN (DN_eingabe))))
  (if DN_lst
    (progn
      (setq D (car DN_lst))
      (setq R (cdr DN_lst))
      (SETQ D2 (/ D 2))
      (rohr_info DN)
      (bogw DN D D2 R)
    ) ;_ progn
  ) ;_ if
  (error_end)
  (moder)
  (princ)
) ;_ defun

;;; --------------------------------------------------------|

(defun c:BOGF ( / D D2 DN DN_LST R )
  (error_begin)
  (modes)
  (SETVAR "cmdecho" 0)
  (setq DN_lst (DN:NennDurchmesser (setq DN (DN_eingabe))))
  (if DN_lst
    (progn
      (setq D (car DN_lst))
      (setq R (cdr DN_lst))
      (SETQ D2 (/ D 2))
      (rohr_info DN)
      (bogf1 DN D D2 R)
    ) ;_ progn
  ) ;_ if
  (error_end)
  (moder)
  (princ)
) ;_ defun
;;; --------------------------------------------------------|

(defun c:BOGL ( / D D2 DN DN_LST R )
  (error_begin)
  (modes)
  (SETVAR "cmdecho" 0)
  (setq DN_lst (DN:NennDurchmesser (setq DN (DN_eingabe))))
  (if DN_lst
    (progn
      (setq D (car DN_lst))
      (setq R (cdr DN_lst))
      (SETQ D2 (/ D 2))
      (rohr_info DN)
      (bogl nil DN D D2 R)
    ) ;_ progn
  ) ;_ if
  (error_end)
  (moder)
  (princ)
) ;_ defun
;;; --------------------------------------------------------|

(defun c:ISOL ( / D D2 DN DN_LST R )
  (error_begin)
  (modes)
  (SETVAR "cmdecho" 0)
  (setq DN_lst (DN:NennDurchmesser (setq DN (DN_eingabe))))
  (if DN_lst
    (progn
      (setq D (car DN_lst))
      (setq R (cdr DN_lst))
      (SETQ D2 (/ D 2))
      (isol1 DN D D2 R)
    ) ;_ progn
  ) ;_ if
  (error_end)
  (moder)
  (princ)
) ;_ defun

;;; --------------------------------------------------------|

(defun c:LINZ ( / D D2 DN DN_LST R )
  (error_begin)
  (modes)
  (SETVAR "cmdecho" 0)
  (setq DN_lst (DN:NennDurchmesser (setq DN (DN_eingabe))))
  (if DN_lst
    (progn
      (setq D (car DN_lst))
      (setq R (cdr DN_lst))
      (SETQ D2 (/ D 2))
      (rohr_info DN)
      (linz DN D D2 R)
    ) ;_ progn
  ) ;_ if
  (error_end)
  (moder)
  (princ)
) ;_ defun
;;; --------------------------------------------------------|

(defun c:IABS ( / D D2 DN DN_LST R )
  (error_begin)
  (modes)
  (SETVAR "cmdecho" 0)
  (c:iso)
  (if (> *#iso_offset 0)
    (progn
      (setq DN_lst (DN:NennDurchmesser (setq DN (DN_eingabe))))
      (if DN_lst
        (progn
          (setq D (car DN_lst))
          (setq R (cdr DN_lst))
          (SETQ D2 (/ D 2))
          (iabs DN D D2 R)
        ) ;_ progn
      ) ;_ if
    )
    (alert
      "Abstand der Isolationslinien vom Rohr nicht eingestellt,\nProgramm wird beendet"
    ) ;_ alert
  )
  (error_end)
  (moder)
  (princ)
) ;_ defun

;;; --------------------------------------------------------|

(defun c:RABS ( / D D2 DN DN_LST R )
  (error_begin)
  (modes)
  (SETVAR "cmdecho" 0)
  (setq DN_lst (DN:NennDurchmesser (setq DN (DN_eingabe))))
  (if DN_lst
    (progn
      (setq D (car DN_lst))
      (setq R (cdr DN_lst))
      (SETQ D2 (/ D 2))
      (rabs DN D D2 R)
    ) ;_ progn
  ) ;_ if
  (moder)
  (error_end)
  (princ)
) ;_ defun
;;; --------------------------------------------------------|

(defun c:RLTG2 ( / D D2 DN DN_LST R )
  (error_begin)
  (modes)
  (SETVAR "cmdecho" 0)
  (setvar "polaraddang" "30;60;120;150;210;240;300;330")
                                        ; max. 10 Werte
  (setvar "polarang" (* 0.25 pi))       ; Spurverfolgung rastet auch in 45 Grad Schritten
  (setvar "polarmode" 4)
  (setq DN_lst (DN:NennDurchmesser (setq DN (DN_eingabe))))
  (if DN_lst
    (progn
      (setq D (car DN_lst))
      (setq R (cdr DN_lst))
      (SETQ D2 (/ D 2))
      (rohrltg DN D D2 R 'T)
    ) ;_ progn
  ) ;_ if
  (error_end)
  (moder)
  (princ)
) ;_ defun

;;; --------------------------------------------------------|

(defun c:RLTG ( / D D2 DN DN_LST R )
  (error_begin)
  (modes)
  (SETVAR "cmdecho" 0)
  (setvar "polaraddang" "30;60;120;150;210;240;300;330")
                                        ; max. 10 Werte
  (setvar "polarang" (* 0.25 pi))       ; Spurverfolgung rastet auch in 45 Grad Schritten
  (setvar "polarmode" 4)
  (setq DN_lst (DN:NennDurchmesser (setq DN (DN_eingabe))))
  (if DN_lst
    (progn
      (setq D (car DN_lst))
      (setq R (cdr DN_lst))
      (SETQ D2 (/ D 2))
      (rohrltg DN D D2 R nil)
    ) ;_ progn
  ) ;_ if
  (error_end)
  (moder)
  (princ)
) ;_ defun
;;; -------------------- auswahl_b -------------------------|

(defun auswahl_b ( DN D D2 R / ANS1 )
  (setq ANS1 "T")
  (while ANS1
    (initget "W B L F E")
    (setq ANS1
           (getkword
             "\n\n[W]inkel-Linien zu Bogen, BOGEN an [B]ogen/[L]inie, Bogen [F]REI setzen  [E]xit: "
           ) ;_ getkword
    ) ;_ setq
    (cond ((= ANS1 "B") (bogb nil DN D D2 R))
          ((= ANS1 "L") (bogl nil DN D D2 R))
          ((= ANS1 "W") (bogw DN D D2 R))
          ((= ANS1 "F") (bogf1 DN D D2 R))
          ((= ANS1 "E") (setq ANS1 nil))
          (T (bogf1 DN D D2 R) (setq ANS1 'T))
    ) ;_ cond
  ) ;_ while
) ;_ defun
;;; --------------------------------------------------------|
;;;
;;;                       auswahl                           |
;;;
;;; --------------------------------------------------------|
(defun auswahl ( DN D D2 R / ANS DN_LST )
  (setq ANS "T")
  (while ANS
    (initget "L B D I R E")
    (setq ANS
           (getkword
             "\n\n[L]inien nachzeichnen, [B]ogen setzen, [D]N, [I]solation, [R]ohrleitung [E]xit: "
           ) ;_ getkword
    ) ;_ setq
    (cond ((= ANS "L") (linz DN D D2 R))
          ((= ANS "B") (auswahl_b DN D D2 R))
          ((= ANS "R") (rohrltg DN D D2 R 'T))
          ((= ANS "E") (setq ANS nil))
          ((= ANS "I") (C:ISO))
          ((= ANS "D")
            (setq DN_lst (DN:NennDurchmesser (setq DN (DN_eingabe))))
            (if DN_lst
              (progn
                (setq D (car DN_lst))
                (setq R (cdr DN_lst))
                (SETQ D2 (/ D 2))
              ) ;_ progn
            ) ;_ if
          )
          (T (rohrltg DN D D2 R 'T) (setq ANS 'T))
    ) ;_ cond
  ) ;_ while
) ;_ defun
;;; --------------------- save modes -----------------------|
;;;
;;; Save modes
;;;
(defun MODES ( / A )
  (setq A
         '("autosnap"      "cmdecho"       "filletrad"
           "orthomode"     "osmode"        "polaraddang"
           "polarang"      "polarmode"     "pickbox"
           "blipmode"      "aunits"        "cecolor"
           "celtype"
          )
  ) ;_ modes
  (setq *#MLST '())
  (repeat (length A)
    (setq *#MLST (append *#MLST (list (list (car A) (getvar (car A))))))
    (setq A (cdr A))
  ) ;_ repeat
)                                       ; defun modes
;;; ------------------ restore modes -----------------------|
;;; Restore modes
;;;
(defun MODER ( )
  (repeat (length *#MLST)
    (setvar (caar *#MLST)
            (cadar *#MLST)
    ) ;_ setvar
    (setq *#MLST (cdr *#MLST))
  )                                     ;repeat
)                                       ; defun moder
;;; --------------------------------------------------------|
(defun c:ROHR ( / D D2 DN DN_LST R )
  (modes)
  (setq *#ROHR_OLDERR
         *error*                        ; Save acad error routine
        *error* rohr_err                ; Substitute eds routine
  ) ;_ setq
  (setvar "cmdecho" 0)
  (setvar "polaraddang" "30;60;120;150;210;240;300;330"); max. 10 Werte
  (setvar "polarang" (* 0.25 pi))       ; Spurverfolgung rastet auch in 45 Grad Schritten
  (setvar "polarmode" 4)
  (setvar "osmode" 0)
  (setvar "pickbox" 5)
  (setq DN_lst (DN:NennDurchmesser (setq DN (DN_eingabe))))
  (if DN_lst
    (progn
      (setq D (car DN_lst))
      (setq R (cdr DN_lst))
      (SETQ D2 (/ D 2))
      (auswahl DN D D2 R)
    ) ;_ progn
  ) ;_ if
  (moder)
  (setq *error* *#ROHR_OLDERR)
  (princ)
) ;_ defun
;;; --------------------------------------------------------|
(defun c:DN ( )
  (DN_eingabe)
  (princ)
)
;;; --------------------------------------------------------|
(defun c:ISO ( )
  (if (not *#iso_offset)
    (setq *#iso_offset 0)
  ) ;_ if
  (setq *#iso_offset
         (rohr:ureal
           0
           ""
           "Abstand der Isolationslinien vom Rohr (0 für keine Iso.)"
           *#iso_offset
         ) ;_ rohr:ureal
  ) ;_ setq
  (if *#iso_offset
    (progn
      (setq *#iso_offset (abs *#iso_offset))
      (prompt "\nGesetzter Abstand der Isolationslinien vom Rohr: ")
      (princ *#iso_offset)
      (princ)
    )
  ) ;_ if
) ;_ defun
;;; --------------------------------------------------------|
(defun c:MLOAD ( / cmd fid menuname )
  (setq menuname "ROHR4")
  (setq fid (getvar "filedia"))
  (setq cmd (getvar "cmdecho"))
  (setvar "filedia" 0)
  (setvar "cmdecho" 0)
  (if (not (menugroup menuname))
    (progn
      (if (findfile (strcat menuname ".mnu"))
        (command "_menuload" menuname)
        (alert (strcat menuname ".MNU nicht gefunden."))
      )
    )
    (alert (strcat "Menü " menuname " ist schon geladen."))
  )
  (setvar "filedia" fid)
  (setvar "cmdecho" cmd)
  (princ)
)
;;; --------------------------------------------------------|
(defun c:MUNLOAD ( / cmd fid menuname )
  (setq menuname "ROHR4")
  (setq fid (getvar "filedia"))
  (setvar "filedia" 0)
  (setq cmd (getvar "cmdecho"))
  (if (menugroup menuname)
    (command "_menuunload" menuname)
    (alert (strcat "Menü " menuname " ist schon entladen."))
  )
  (setvar "filedia" fid)
  (setvar "cmdecho" cmd)
  (princ)
)
;;; --------------------------------------------------------|
(defun C:RHILFE ( )
  (alert
    (strcat
      "\n\n\ Programmbefehle:"
      "\n"
      "\n \tIst für den Abstand der Isolationslinien vom Rohr ein Wert größer 0 gesetzt worden,"
      "\n \twerden die Linien für die Isolation gleichzeitg mit dem Rohr gezeichnet."
      "\n"
      "\n-----------------------------------------------------------------------------"
      "-------------------------------------------------------------------------------"
      "\n BOGB \t..... Rohr-Bogen an Bogen ansetzen"
      "\n BOGF \t..... Rohr-Bogen frei in die Zeichnung setzen"
      "\n BOGL \t..... Rohr-Bogen an Mittel-Linie ansetzen"
      "\n BOGW \t..... Zwei Linien, die einen Winkel bilden, in einen Rohr-Bogen umwandeln"
      "\n DN   \t..... DN-Wert eingeben oder mit \"frei\" zur freien Eingabe von Durchmesser u. Radius"
      "\n ISO  \t..... Abstand der Isolationslinien vom Rohr eingeben, 0 = keine Isolationslinien"
      "\n ISOL \t..... Isolationslinien erzeugen durch picken der Mittellinie des Rohrs"
      "\n SSP \t..... SCHNITT-SYMBOL für Rohrleitung PARALLEL zur Zeichnungsebene"
      "\n SSS \t..... SCHNITT-SYMBOL für Rohrleitung SENKRECHT zur Zeichnungsebene"
      "\n ----------"
      "\n IABS \t..... Isolierungsstück durch picken der Mittel-Linie abschliessen (auch Bogen)"
      "\n LINZ \t..... Linienzüge in Rohr umwandeln (erzeugen der Isolation am Ende möglich)"
      "\n RABS \t..... Rohrleitungsstück abschliessen (auch Bogen)"
      "\n RLTG \t..... Rohrleitung ... fortlaufend zeichnen (mit freier Winkelwahl)"
      "\n RLTG2 \t..... Rohrleitung ... fortlaufend zeichnen (mit Einrastung auf bestimmte Winkelwerte)"
      "\n ----------"
      "\n ROHR \t..... zum Kommandozeilen-Menü:"
      "\n      \t      1.) Linien nachzeichnen (Mittel-Linien zum Rohr erweitern)"
      "\n      \t      2.) Untermenü \"BOGEN SETZEN\""
      "\n      \t\t      1.) Zwei Linien, die einen Winkel bilden, in einen Rohr-Bogen umwandeln"
      "\n      \t\t      2.) Rohr-Bogen an Bogen ansetzen"
      "\n      \t\t      3.) Rohr-Bogen an Linie ansetzen"
      "\n      \t\t      4.) Rohr-Bogen frei in die Zeichnung setzen"
      "\n      \t      3.) Rohrleitung ... fortlaufend zeichnen (mit Einrastung auf bestimmte Winkelwerte)"
      "\n ----------"
      "\n MLOAD \t\t..... Icon-Menü laden"
      "\n MUNLOAD \t..... Icon-Menü entladen"
      "\n-----------------------------------------------------------------------------"
      "-------------------------------------------------------------------------------") ;_ strcat
  ) ;_ alert
) ;_ defun

(princ "\nROHR4.lsp  13.03.2003")

(princ
  "\nStart mit ROHR  ... Liste der Programmbefehle mit RHILFE ... Icon-Menü mit MLOAD"
) ;_ princ
(princ)