;............................................................
;:      DATE : 92-01-01    Kunde: tewi                      :
;:      Autor: Schmidt     AutoCAD-Version 11               :
;:      Version 1.5        ab Version 10 mit anpassen       :
;:                                                          :
;:      KONST.LSP          Konstruktionslinien              :
;:..........................................................:

(SPECIAL '(oofs spal))

(DEFUN xtan (win dist)  ;gibt Laenge der Ankat mit Win. und Gegegkat
    (IF (= win 0)
        (SETQ win PI)
    )
    (/ dist (/ (SIN win)(COS win)))
)

(DEFUN basl (bast / esel ctyt)                   ;Basislinien-Dialog
    (SETQ ctyt ctype
          ctype 0
    )
    (IF (SETQ esel (ENTSEL (STRCAT "\nSelect the " bast "basicalline: ")))
        (IF (= "LINE" (CDR (ASSOC '0 (SETQ elsl (ENTGET (NTH 0 esel))))))
            (PROGN
                (SETQ punkt (OSNAP (NTH 1 esel) "_NEA")
                      angl (ANGLE (TRANS (CDR (ASSOC '10 elsl)) 0 1)
                             (TRANS (CDR (ASSOC '11 elsl)) 0 1)
                           )
                      ctype ctyt
                )
                (IF (OR (OR (EQUAL angl 0.0 0.00000000001)
                            (EQUAL (- angl PI) 0.0 0.00000000001)
                        )
                        (EQUAL (- angl PI PI) 0.0 0.00000000001)
                    )
                    (SETQ angl 0.0)
                )
            )
            (emsg "no valid object found!")
        )
        (emsg "no object found!")
    )
)

(DEFUN punk ()                                   ;Punkt-Dialog
    (IF (NULL (SETQ punkt (GETPOINT "\nSelect point: ")))
        (PROGN
            (emsg "no valid point!")
            (SETQ ctype 0)
        )
    )
)

(DEFUN wink ()                                   ;Winkel-Dialog
    (IF (NULL (SETQ angl (GETANGLE "\nType in angle: ")))
        (PROGN
           (emsg "no valid angle ")
           (SETQ ctype 0)
        )
    )
)

(DEFUN vers (vset)                               ;Versatz-Dialog
    (IF vset
        (PROGN
            (IF (NULL oofs) (SETQ oofs 0))
            (IF (NULL (SETQ eofs (GETDIST (STRCAT "\nType in offset <" (RTOS oofs)">: "))))
                (SETQ eofs oofs)
            )
            (IF (/= eofs 0)
                (PROGN
                    (SETQ anpt (GETPOINT "\nSide of the positive offset: "))
                    (IF anpt
                        (SETQ anse (ANGLE punkt anpt))
                        (PROGN
                            (emsg "no valid input!")
                            (SETQ ctype 0)
                        )
                    )
                )
            )
            (SETQ anba (IF (> angl PI)(- angl PI)(EVAL angl))
                  oofs eofs
            )
        )
    )
    (IF (> ctype 0)
        (IF (OR (< anse anba)(> anse (+ anba PI)))
            (SETQ punkt (POLAR punkt (+ anba (* 3 (/ PI 2))) eofs))
            (SETQ punkt (POLAR punkt (+ anba (/ PI 2)) eofs))
        )
    )
)


(DEFUN rech (/ andi angd ptdi pttp lauf lip1 lip2 scnp)    ;Berechnen
   (IF (>= angl PI)
      (SETQ angl (- angl PI))
   )
   (IF (OR (EQUAL angl 0.0 0.00000000001)
           (EQUAL (- angl PI) 0.0 0.00000000001)
       )
      (SETQ angl 0.0)
   )
   (SETQ g:l5 g:l1
         andi (IF (> angl (/ PI 2))(QUOTE 1)(QUOTE 0))
         angd (IF (= andi 1)(- PI angl) angl)
         ptdi (IF (= andi 1)(* -1 (xtan angd 100))(xtan angd 100))
         pttp (MAPCAR '+ punkt (APPEND (if (= angl 0) '(100 0)(LIST ptdi 100)) '(0)))
         lip1 (INTERS g:l1 g:l2 punkt pttp NIL)
         lip2 (INTERS g:l3 g:l4 punkt pttp NIL)
         lauf 1
         g:s1 NIL
         g:s2 NIL
         scnp "g:s1"
   )
   (IF (NULL lip1)
        (SETQ lip1 (INTERS g:l2 g:l3 punkt pttp NIL)
              lip2 (INTERS g:l4 g:l1 punkt pttp NIL)
        )
    )
    (IF (AND lip1 lip2)                 ;2D
        (PROGN
            (WHILE (AND (< lauf 5)(NULL g:s2))
                (SET (READ scnp) (INTERS lip1 lip2
                       (EVAL (READ (STRCAT "g:l" (ITOA lauf))))
                       (EVAL (READ (STRCAT "g:l" (ITOA (setq lauf (1+ lauf))))))
                                  )
                )
                (IF (AND (= scnp "g:s1") g:s1)
                    (SETQ scnp "g:s2")
                )
            )
            (IF (NULL g:s2)
                (PROGN
                    (emsg "Line offside limits. Redefine it with the command LIMITS!")
                    (SETQ ctype 0)
                )
            )
        )
        (PROGN
           (emsg "not a valid line ! - it has Z-Coordinates > 0!")
           (SETQ ctype 0)
        )
    )
)

(DEFUN lmake (cli1 cli2)                         ;Linie erzeugen
    (IF (AND cli1 cli2)
        (ENTMAKE (LIST (CONS 0 "LINE")
                       (CONS 8 CO%%)
                       (CONS 10 (TRANS cli1 1 0))
                       (CONS 11 (TRANS cli2 1 0))
                 )
        )
        (PROGN
            (PRINC "no constructions line possible!")
            (SETQ ctype 0)
        )
    )
)

(DEFUN whalb (/ isec ang1 ang2)                  ;Winkelhalbierende
    (SETQ isec (APPEND (LIST (TRANS
                     (CDR (ASSOC '10 elsl)) 0 1))
                     (LIST (TRANS (CDR (ASSOC '11
                     elsl)) 0 1))
               )
          ang1 angl
    )
    (basl "zweite ")
    (SETQ isec (APPEND isec (LIST (TRANS
                     (CDR (ASSOC '10 elsl)) 0 1))
                     (LIST (TRANS (CDR (ASSOC '11
                     elsl)) 0 1))
               )
          ang2 angl
          punkt (INTERS (NTH 0 isec)
                        (NTH 1 isec)
                        (NTH 2 isec)
                        (NTH 3 isec) NIL
                )
          angl (+ ang1 (/ (- ang2 ang1) 2))
    )
    (IF punkt
        (PROGN
            (rech)
            (lmake g:s1 g:s2)
            (SETQ angl (+ angl (/ PI 2)))
        )
        (SETQ ctype 0)
    )
)

(DEFUN mulip (/ anba pbas anzv eofs)           ;Mehrfach Versatz
    (GRAPHSCR)
    (basl "")
    (SETQ pbas punkt)
    (IF (> ctype 7)
        (PROGN
            (vers T)
            (COND
                ((= ctype 8)
                    (IF (/= eofs 0)
                        (SETQ anzv (GETINT "\nHow many lines ?: "))
                        (SETQ anzv 1)
                    )
                    (IF anzv
                        (REPEAT anzv
                            (IF (> ctype 7)
                                (PROGN
                                    (rech)
                                    (IF (> ctype 7)
                                        (PROGN
                                            (lmake g:s1 g:s2)
                                            (vers NIL)
                                         )
                                     )
                                )
                            )
                        )
                        (emsg "Programm canceled!")
                    )
                )
                ((= ctype 9)
                    (WHILE (> ctype 7)
                        (rech)
                        (IF (> ctype 7)
                            (PROGN
                                (lmake g:s1 g:s2)
                                (IF (> ctype 7)
                                    (PROGN
                                        (IF (SETQ eofs (GETDIST pbas
                                          "\nType in offset: "))
                                            (PROGN
                                                (SETQ punkt pbas
                                                      oofs eofs
                                                )
                                                (vers NIL)
                                            )
                                            (SETQ ctype 0)
                                        )
                                    )
                                )
                            )
                        )
                    )
                )
            )
        )
    )
)

(DEFUN redi (/ grpu sepu)            ;Risserg„nzungs-Dialog
  (SETQ ctype 0)
  (IF (SETQ grpu (GETPOINT "\nPoint in the ground plan"))
     (IF (SETQ sepu (GETPOINT "\nPoint in ground plan: "))
         (IF (NOT (OR (MINUSP (CAR (SETQ tofs (MAPCAR '- sepu grpu))))
                      (MINUSP (CADR tofs))
                  )
             )
            (IF (SETQ punkt (INTERS grpu (MAPCAR '+ grpu '(10 0 0))
                                    sepu (MAPCAR '+ sepu '(0 10 0)) NIL
                            )
                )
               (PROGN
                   (SETQ angl (* 3 (/ PI 4)))
                   (rech)
                   (SETQ spal (LIST g:s1 g:s2 g:l1 g:l3)
                         ctype 10
                   )
               )
               (emsg "no intersection between the lines! ")
            )
            (emsg "no valid points! ")
         )
         (emsg "no point calculated! ")
     )
     (emsg "no point defined! ")
  )
)

(DEFUN rier (/ spap rip1 rip2 stpt enpt hori lpen)    ;Rissergaenzung
    (INITGET 1 "Yes No  No")
    (IF (AND spal (AND (EQUAL (NTH 2 spal) g:l1)(EQUAL (NTH 3 spal) g:l3)))
        (IF (= (GETKWORD "\nDefine new mirror axis? <N>: ") "Yes")
            (redi)
        )
        (redi)
    )
    (WHILE (> ctype 0)
        (IF (SETQ rip1 (GETPOINT "\nSelect point: "))
            (PROGN
                (IF (EQUAL (ANGLE (NTH 0 spal)(NTH 1 spal))
                                  (/ (* PI 3) 4) 0.0000001)
                    (SETQ stpt 0
                          enpt 1
                    )
                    (SETQ stpt 1
                          enpt 0
                    )
                )
                (IF (MINUSP (- (ANGLE (NTH stpt spal)(NTH enpt spal))
                               (ANGLE (NTH stpt spal) rip1)
                            )
                    )
                    (SETQ angl 0.0
                          hori T
                    )
                    (SETQ angl (/ (* PI 3) 2)
                          hori NIL
                    )
                )
                (SETQ punkt rip1)
                (rech)
                (IF (> ctype 0)
                    (IF (SETQ spap (INTERS (NTH 0 spal)(NTH 1 spal) g:s1 g:s2))
                        (PROGN
                            (IF hori
                                (SETQ angl (/ PI 2))
                                (SETQ angl 0.0)
                            )
                            (SETQ punkt spap)
                            (rech)
                            (IF (> ctype 0)
                               (PROGN
                                   (lmake rip1 spap)
                                   (IF hori
                                      (IF (EQUAL (ANGLE spap g:s1)
                                            (/ PI 2) 0.0000001)
                                         (SETQ lpen g:s1)
                                         (SETQ lpen g:s2)
                                      )
                                      (IF (EQUAL (ANGLE spap g:s1) PI 0.0000001)
                                         (SETQ lpen g:s1)
                                         (SETQ lpen g:s2)
                                      )
                                   )
                                   (lmake spap lpen)
                               )
                               (emsg "Mirror axis will not intersected!")
                            )
                        )
                        (emsg "Mirror axis will not intersected!")
                    )
                )
            )
            (SETQ ctype 0)
        )
    )
)

(DEFUN eaconst (cosw / xlay)                     ;Ein/Aus-Schalten
    (IF (SETQ xlay (TBLSEARCH "LAYER" CO%%))
        (IF (OR (= (CDR (ASSOC '70 xlay)) 65)(MINUSP (CDR (ASSOC '62 xlay))))
            (COMMAND "_LAYER" "_T" CO%% "_on" CO%% "")
            (IF cosw
               (COMMAND "_LAYER" "_off" CO%% "")
            )
        )
        (COMMAND "_LAYER" "_N" CO%% "_color" RO%% CO%% "")
    )
)

(DEFUN delcon (/ count edel)                     ;Konstlin. L”schen
    (IF (ques "Delete the construction aids?" NIL)
        (PROGN
            (PRINC "\nPlease wait")
            (SETQ edel (SSGET "X" (LIST (CONS '8 CO%%)))
                  count 0
            )
            (IF edel
                (REPEAT (SSLENGTH edel)
                    (ENTDEL (SSNAME edel count))
                    (SETQ count (1+ count))
                    (PRINC ".")
                )
            )
            (REDRAW)
        )
    )
)

(DEFUN const (ctype / g:l1 g:l2 g:l3 g:l4 punkt angl g:s1 g:s2 eofs anse elsl)
    (pstart "Construction aids" "" NIL)
    (SETQ g:l1 (GETVAR "limmin")
          g:l3 (GETVAR "limmax")
          g:l2 (TRANS (LIST (car g:l3)(cadr g:l1)) 0 1)
          g:l4 (TRANS (LIST (car g:l1)(cadr g:l3)) 0 1)
          g:l1 (TRANS g:l1 0 1)
          g:l3 (TRANS g:l3 0 1)
          co%% "CONST"
          ro%% "8"
    )
    (IF (/= ctype 11)
        (eaconst NIL)
    )
    (IF (AND (> ctype 0) (< ctype 13))
        (COND
           ((< ctype 8)
            (PROGN
                (GRAPHSCR)
                (IF (> ctype 4)
                    (basl "")
                    (punk)
                )
                (IF (< ctype 3)
                    (IF (= ctype 1)
                        (SETQ angl 0.0)
                        (SETQ angl (/ PI 2))
                    )
                )
                (IF (AND (> ctype 2)(< ctype 5))
                    (wink)
                )
                (IF (OR (> ctype 6)(= ctype 4))
                    (vers T)
                )
                (IF (= ctype 5)
                    (PROGN
                        (punk)
                        (IF (> ctype 0)
                           (PROGN
                              (IF (SETQ atmp (GETANGLE
                                "\nAngle to the basic line <90>: "))
                                 (SETQ angl (+ angl atmp))
                                 (SETQ angl (+ angl (/ PI 2)))
                              )
                           )
                        )
                        (WHILE (> angl PI)
                            (SETQ angl (- angl PI))
                        )
                    )
                )
                (IF (= ctype 6) (whalb))
                (IF (> ctype 0)
                    (rech)
                )
                (IF (> ctype 0)
                    (lmake g:s1 g:s2)
                )
              )
            )
            ((OR (= ctype 8)(= ctype 9)) (mulip))
            ((= ctype 10)(rier))
            ((= ctype 11)(eaconst T))
            ((= ctype 12)(delcon))
        )
    )
    (pend)
)

(DEFUN c:khoriz () (const 1))
(DEFUN c:kverti () (const 2))
(DEFUN c:kschr () (const 3))
(DEFUN c:kschrv () (const 4))
(DEFUN c:keschr () (const 5))
(DEFUN c:kwhalb () (const 6))
(DEFUN c:kvers () (const 7))
(DEFUN c:kversr () (const 8))
(DEFUN c:kversu () (const 9))
(DEFUN c:krisserg () (const 10))
(DEFUN c:kea () (const 11))
(DEFUN c:kdel () (const 12))
(DEFUN c:konst () (PRINC "\nConstruction aids loaded"))
(c:konst)
(PRINC)