; Datei DAEMMW.LSP
; Erzeugt eine Schraffur für eine weiche Dämmung
;
(prompt (strcat 
          "\n\n\nRoutine für das Zeichnen einer weichen Dämmung wird geladen..."
	)
)
;Unterprogramm "Sichern der Umgebungsvariabeln"
(defun init ()
  (setq
        Blx (getvar "BLIPMODE") ; Konstruktionspunkte
        Cmx (getvar "CMDECHO")  ; Befehlsdialog
	Grx (getvar "GRIDMODE") ; Raster
	Osx (getvar "OSMODE")   ; Objektfang
	Snx (getvar "SNAPMODE") ; Famgmodus
	Ucx (getvar "UCSFOLLOW"); Einfluss eines BKS-Wechsels
  )
  (setvar "BLIPMODE" 0)
  (setvar "CMDECHO" 0) 
  (setvar "GRIDMODE" 0)
  (setvar "OSMODE" 0)  
  (setvar "SNAPMODE" 0)
  (setvar "UCSFOLLOW" 0)
  (setvar "ANGDIR" 0)
  (setvar "AUNITS" 0)
)

(defun reinit ()
  (setvar "BLIPMODE" Blx)
  (setvar "CMDECHO" Cmx) 
  (setvar "GRIDMODE" Grx)
  (setvar "OSMODE" Osx)  
  (setvar "SNAPMODE" Snx)
  (setvar "UCSFOLLOW" Ucx)
)

;Unterprogramm  "Error-Funktion bei vorzeitigem Abbruch"
(defun clerr (s)
  (if (/= s "Funktion abgebrochen")
    (progn
       (princ (strcat 
              "\nFehlerursache: " 
              s
              )
       )
       (command "Zurück" "R")
    )
  )
  (setvar "BLIPMODE" Blx)
  (setvar "CMDECHO" Cmx) 
  (setvar "GRIDMODE" Grx)
  (setvar "OSMODE" Osx)  
  (setvar "SNAPMODE" Snx)
  (setvar "UCSFOLLOW" Ucx)
  (command "_.layer" "_S" clay "")
  (setq *error* olderr)
  (princ)
)

; Unterprogramm "Layer "Dämmung" prüfen und ggf. anlegen"
(defun LAYEREIN (lname / oldreg)
  (if (not (tblsearch "LAYER" lname)) ; Durchsuchen der Layertabelle
    (progn                            ; wenn nicht gefunden dann
      (prompt (strcat 
                "\nEin Augenblick, Layer "  ; wird der Layer angelegt
                lname
                " wird angelegt ... "
      )       )
      (setq oldreg (getvar "REGENMODE")) 
      (setvar "REGENMODE" 0)
      (command "_.LAYER" 
                 "_N" lname 
                 "_C" 3 lname
               ""
      )
      (setvar "REGENMODE" oldreg)
    ) 
   )
  (command "_.LAYER"                ; Layer wird eingeschaltet
           "_S" lname
           ""
  )
)

; Unterprogramm "WKS einschalten"
(defun WKSEIN (/ oldreg)
   (setq oldreg (getvar "REGENMODE")) 
   (setvar "REGENMODE" 0)
   (command "_.UCS" 
            "_W"
   )
   (command "_.UCSICON" 
            "_OF"
   )
   (setvar "REGENMODE" oldreg)
   (princ)
)

; Daemmung zeichnen und Koordinaten der Begrenzungslinien abfragen
(defun DAEMMZEI 
       (/ L1 L2 P1 P2 P3 P4 P5 P6 P10 P13 P14 P15 P16 P18 P19 L AUSW
          AN1 AN2 AN3 AN4 AN5 NX NU AX PX XT X1 Y1 Z1 X2 Y2 Z2 X3 Y3 Z3 
          X4 Y4 Z4 Nenner1 Nenner2 COSA1 COSB1 COSG1 COSA2 COSB2 COSG2 
          KP1 KP2 KP3 KP4 KP5 KP6 A B C D DX DX1 DX2 DX3 DX4 ABS1 ABS2)
; Koordinaten einlesen
   (setq L1 (entget (car (entsel "\n1. Begrenzungslinie zeigen:"))))
   (setq L2 (entget (car (entsel "\n2. Begrenzungslinie zeigen:"))))
   (setq P1 (cdr (assoc 10 L1))) 
   (setq P2 (cdr (assoc 11 L1)))          
   (setq P3 (cdr (assoc 10 L2))) 
   (setq P4 (cdr (assoc 11 L2))) 
   (setq X1 (nth 0 P1))
   (setq Y1 (nth 1 P1))
   (setq Z1 (nth 2 P1))
   (setq X2 (nth 0 P2))
   (setq Y2 (nth 1 P2))
   (setq Z2 (nth 2 P2))
   (setq X3 (nth 0 P3))
   (setq Y3 (nth 1 P3))
   (setq Z3 (nth 2 P3))
   (setq X4 (nth 0 P4))
   (setq Y4 (nth 1 P4))
   (setq Z4 (nth 2 P4))

; Prüfen ob die Geraden parallel liegen
   (setq Nenner1 (sqrt (+(expt (- X2 X1)2)(expt (- Y2 Y1)2)(expt (- Z2 Z1)2))))
   ; Berechnung des Nenners für die Berechnung der Richtungscosina der
   ; 1. Begrenzungslinie
   (setq Nenner2 (sqrt (+(expt (- X4 X3)2)(expt (- Y4 Y3)2)(expt (- Z4 Z3)2))))
   ; Berechnung des Nenners für die Berechnung der Richtungscosina der 
   ; 2. Begrenzungslinie
   (setq COSA1 (/(- X2 X1) Nenner1)) ; Richtungscosina
   (setq COSB1 (/(- Y2 Y1) Nenner1)) ; fuer 1. Begrenzungs-
   (setq COSG1 (/(- Z2 Z1) Nenner1)) ; linie
   (setq COSA2 (/(- X4 X3) Nenner2)) ; Richtungscosina
   (setq COSB2 (/(- Y4 Y3) Nenner2)) ; fuer 2. Begrenzungs-
   (setq COSG2 (/(- Z4 Z3) Nenner2)) ; linie
   ; Wenn a x b = 0 dann linien parallel
   (setq KP1 (- (* COSB1 COSG2)(* COSG1 COSB1))) ; Kreuzprodukt
   (setq KP2 (- (* COSG1 COSA2)(* COSA1 COSG2))) ; beider
   (setq KP3 (- (* COSA1 COSB2)(* COSB1 COSA2))) ; Richtungsvektoren
   (setq KP3 (+ KP3 KP2))
   (setq KP3 (+ KP3 KP1))
;Fehlerroutine
;   (if (/= KP3 0)
;         (progn
;            (clerr "Linien müssen parallel liegen.")
;            (setvar "CMDECHO" 0)
;            (exit)
;         )
;   )

; Abstand der Linien bestimmen 
   (setq A (- X3 X1))
   (setq B (- Y3 Y1))
   (setq C (- Z3 Z1))
   (setq KP4 (- (* B COSG1)(* C COSB1)))
   (setq KP5 (- (* C COSA1)(* A COSG1)))
   (setq KP6 (- (* A COSB1)(* B COSA1)))
   (setq ABS1 (sqrt (+ (expt KP4 2)(expt KP5 2)(expt KP6 2)))) 
   (setq ABS2 (sqrt (+ (expt COSA1 2)(expt COSB1 2)(expt COSG1 2))))
   (setq D (/ ABS1 ABS2))
;Variabeln berechnen 
   (setq DX (distance P1 P2)) ; Länge der 1. Begrenzungslinie
   (setq DX2 (distance P3 P4)) ; Länge der 2. Begrenzungslinie
   (setq DX3 (distance P1 P3)) ; Länge der Geraden von P1 nach P3 
   (setq DX4 (distance P2 P4)) ; Länge der Geraden von P2 nach P4 
;  (setq DX (min DX1 DX2))     ; Kürzeste Begrenzungslinie bestimmen
;Überprüfung des Richtungssinns der Geraden
   (setq AN1 (angle P1 P2))     ; Winkel der 1. Linien im Raum
   (setq AN2 (angle P3 P4))     ; Winkel der 2. Linien im Raum
   (if (>= AN1 pi)                ;Abfrage ob Winkel der 1. Linie größer als PI ist
       (progn                     ;wenn ja dann Endpunkte tauschen
          (setq P5 P1             ;Anfangspkt d. 1. Linie auf P5 zwischengespeichert
                P1 P2             ;Anfangspkt d. 1. Linie auf P2 gewechselt
                P2 P5)            ;Endpunkt P2 durch Anfangspkt P1 ausgetauscht
       )
   )
   (setq AN1 (angle P1 P2))       ;Winkel der 1. Linien im Raum neuberechnen
   (if (/= AN2 AN1)               ;Abfrage ob Linien gleichen Richtungssinn haben
       (progn                     ;wenn ungleich dann Endpunkte der 2. Linie tauschen
           (setq P6 P4            ;Endpunkt der 2. Linie auf P6 zwischengespeichert
             P4 P3                ;Anfangspkt d. 2. Linie auf P4 gewechselt
             P3 P6)               ;Endpunkt auf P3 gewechselt
       )
   )
   (setq AN2 (angle P3 P4))     ; Winkel der 2. Linien im Raum neuberechnen
;Überprüfung der Lage der Geraden und Bestimmung des Startpunktes der Dämmung
   (setq AN3 (angle P1 P3))     ; Winkel der Geraden von P1 nach P3
   (setq AN4 (angle P2 P4))     ; Winkel der Geraden von P2 nach P4
   (setq AN5 (- AN3 AN1))
   (if (or (and (< AN5 '0) (< AN3 pi)) (and (> AN5 pi) (> AN3 pi)))
       (progn
         (setq P1 P3)
       ) 
   )
   (setq NX (/ D 2.5)          ; Versatz der Daemmkurven
         NU (/ DX NX)           ; Anzahl der Wiederholungen zum Zeichnen 
         AX (+ AN1 (/ pi 2))    ; Winkel der Geraden + 90°
         PX (polar P1 AX D)    ; Punkt senkrecht zum Ausgangspunkt
         P10 (polar P1 AX (/ D 1.25))
         P13 (polar P10 AN1 (/ D 5))
         P14 (polar P10 AN1 (/ D 2.5))
         P15 (polar P1 AX (/ D 5))
         P16 (polar P15 AN1 (/ D 5))
         P18 (polar P15 AN1 (/ D 2.5))
         P19 (polar P1 AN1 (/ D 2.5))
         SP1 P1
    )
; Daemmung zeichnen 
    (repeat (fix NU)
          (command "_.ARC" "_C" P15 P1 P16) 
          (command "_.LINE" P16 P10 "") 
          (command "_.ARC" P10 "_C" P13 "_A" "-180") 
          (command "_.LINE" P14 P16 "") 
          (command "_.ARC" "_C" P18 P16 P19)
          (setq P1 (polar P1 AN1 NX)
            P10 (polar P10 AN1 NX)
            P13 (polar P13 AN1 NX)
            P14 (polar P14 AN1 NX)
            P15 (polar P15 AN1 NX)
            P16 (polar P16 AN1 NX)
            P18 (polar P18 AN1 NX)
            P19 (polar P19 AN1 NX)
          )
    )
    (setq XT (distance P1 P2))
    (if (>= XT (/ D 5))
      (command "_.ARC" "_C" P15 P1 P16 "_.LINE" P16 P10 ""
      "_.ARC" P10 "_C" P13 "_A" "-75")
    )
; Erzeugen einer Polylinie  
    (setq L (ssget "L"))
    (setq AUSW (ssget "X" ' ((8 . "A_Schraff"))))
    (command "_.pedit" "l" "J" "V" AUSW "" "") ; Umwandlung in zusammenhängende Plinie
    (setq L nil)                        ; Löschen des Auswahlsatzes
    (setq AUSW nil)                     ; Löschen des Auswahlsatzes
;Umschalten auf Layer "0" nach Beendigung des Zeichnens
    (command "_.LAYER"                ; Layer 0 wird eingeschaltet
           "_S" "0"
           ""
    )
); Ende Daemmzei


; Hauptprogramm
(defun C:DAEMM (/ lname clay olderr)
	(graphscr)
	(init)
        (command "Zurück" "M")
        (command "Zurück" "B")
	(setq clay (getvar "CLAYER"))
	(setq olderr *error*
              *error* clerr)
        (setq lname "019-3-ar-waermedaemmung")
	(layerein lname)
	(WKSEIN)
	(DAEMMZEI)
        (command "Zurück" "E")
        (REINIT)
        (setq *error* olderr)
(princ)
)