;	Für AutoCAD Version 2023
;	Nicht getestet unter ältern Versionen, in denen kann es aufgrund von internen
;	Befehls-Änderungen zu unerwarteten Reaktionen kommen.
;	Dateiname: DR_PLATTE_A.LSP - erstellt: 03.01.2024 - Dieter Ribbrock
;	http://www.ribbrock-online.de
;	Datei erstellt eine Plattenkonstruktion mit Massivholzkante
;	Aufruf:	dr_platte_a
;
;	Das Programm wird dem Benutzer - "in dieser Form" - zur Verfügung gestellt.
;	Für eventuelle Programmfehler oder Schäden durch die Anwendung wird keine Haftung übernommen.
;
;	Erforderliche Eingaben:
;	SP		Anfangs-/Startpunkt <Punkt> <SP> = siehe Markierungen in Dia
;	EP		Endpunkt der Platte (Länge über Zeigen der Richtung und Werteeingabe oder Länge über Picken des Endpunktes)
;	Ort		bei J: Rechts oder Unterhalb der Richtungslinie / bei N: Links oder Oberhalb der Richtungslinie
;	Roh		Rohdicke
;	Anl		Stärke Anleimer/Kante

;--------------------------------------------------------
; Winkel in Rad umrechnen
;--------------------------------------------------------

(defun aib (w)								;
    (* pi (/ w 180.0))
)

;--------------------------------------------------------
; Eingabe
;--------------------------------------------------------

(defun plmasse1 ()							;
	(setq abb "1")							;
	(setq an "")							;
  
	;
  
	(prompt "\nDie Daten aus der Dialogboxeingabe werden benutzt ...")		;
	(setq num (load_dialog "dr_platte_a"))
	(new_dialog "dr_platte_a" num)
	(mode_tile "kzz_dcl" 2)						;
	(action_tile "ueb_dcl" "(do_ueber)")				;

 	(action_tile "zomg_dcl" "(do_zomgr)")
  
	(action_tile "kzz_dcl" "(do_txt)")				; 
	(action_tile "rohdicke_dcl" "(do_dicke)")			; 
	(action_tile "anl_dcl" "(do_anleimer1)")			; 
	(action_tile "cancel" "(do_abbruch) (done_dialog)")
	(action_tile "accept" "(do_txt) (do_anleimer1) (do_ueber) (do_zomgr) (do_dicke) (done_dialog)")

	(start_image "BILD")						;
        (slide_image 35 15 280 90 "DR_PLATTE_A(bild)")			;
	(end_image)

 	(start_image "LOGO")						; 
	(slide_image 25 5 150 100 "DR_PLATTE_A(logo)")			; 
	(end_image)

  	(start_dialog)
	(unload_dialog num)
)

	;

(defun punkte1 ()							;
    (if (= abb "1")						
    (progn
      (setq sp (getpoint "\nZeigen und Picken des Anfangspunkts der Platte: "))
      (setq ep (getpoint sp "          Richtung zeigen und Länge (>= 35) eingeben oder Endpunkt der Platte picken: "))
      (setq ort (getstring "\nPlatte unterhalb bzw. rechts der Linie zeichnen <J> Platte oberhalb bzw. links der Linie zeichnen <N>): "))		;
      
        (if (or (= ort "") (= ort "j"))					;
            (setq ort "J")
        )
      
      (setq laenge (distance sp ep))					;
      (setq rohdicke (ATOF roh))					;
      (setq rohdicke (FIX rohdicke))					;
      (setq dicke (+ rohdicke 1))					;
      (setq winkel (angle sp ep))
      
      (if (= ueb "1")							;
          (setq ueber "J")
        (setq ueber "N")
      )

      (if (= zomg "1")							;
          (setq zomgr "J")
        (setq zomgr "N")
      )
      ;

      (setq winpl90 (+ winkel (aib 90)))
      (setq winpl45 (+ winkel (aib 45))) 
      (setq winmi45 (- winkel (aib 45))) 
      (setq winpl135 (+ winkel (aib 135))) 
      (setq winmi135 (- winkel (aib 135))) 
      (setq winpl180 (+ winkel (aib 180)))
      (setq winmi90 (- winkel (aib 90)))
      (setq w (/ (* winkel 180) pi))
      (if (and (> w 115) (< w 295))
          (setq w (+ w 180))
      )
    )
    (prompt "\n***Abbruch***")
  )
)

;--------------------------------------------------------
; Ende der Eingaben - Funktionen der Dialogbox
;--------------------------------------------------------

(defun do_txt ()
      (setq kzz (get_tile "kzz_dcl"))
)
(defun do_dicke ()
      (setq roh (get_tile "rohdicke_dcl"))
)
(defun do_anleimer1 ()
      (setq an (get_tile "anl_dcl"))    
      (setq anl (ATOF an))       
)
(defun do_ueber ()
      (setq ueb (get_tile "ueb_dcl"))
)
(defun do_zomgr ()
      (setq zomg (get_tile "zomg_dcl"))	
)
(defun do_abbruch ()
      (setq abb "0")
)

;--------------------------------------------------------
; Umriss der Platte erstellen
;--------------------------------------------------------

(defun umriss1 ()
  
      (command "LAYER" "M" "LT-A" "FA" "7" "LT-A" "")
      (command "LAYER" "LT" "CONTINUOUS" "" "")
  
      (setq p1 (polar sp winmi90 dicke))
      (if (or
          (and (and (> winkel (* pi 0.5)) (<= winkel (* pi 1.5))) (= ort "J"))     
          (and (or (<= winkel (* pi 0.5)) (> winkel (* pi 1.5))) (/= ort "J"))
          )
          (setq p1 (polar sp winpl90 dicke))
      )
      (setq p2 (polar p1 winkel laenge))
      (setq p3 (polar p1 winkel anl))
      (setq p4 (polar sp winkel anl))
      (setq px (polar p3 winpl90 (/ dicke 2)))
      (if (or
          (and (and (> winkel (* pi 0.5)) (<= winkel (* pi 1.5))) (= ort "J"))     
          (and (or (<= winkel (* pi 0.5)) (> winkel (* pi 1.5))) (/= ort "J"))
          )
          (setq px (polar p3 winmi90 (/ dicke 2)))				;
      )
      (command "linie" p3 p2 ep p4 "")						;
      (command "plinie" sp p4 p3 p1 sp "")					;

)

;--------------------------------------------------------
; Text einsetzen
;--------------------------------------------------------

(defun textbez1 ()
     (setq d2 (/ dicke 2.0))
     (setq d3 (/ dicke 3.0))
     (setq l2 (/ laenge 2.0))
     (setq l4 (/ laenge 4.0))
  
    (setq m1 (polar p3 winkel 30))					;
	(if (< (distance P3 P2) 50)					;
        (setq m1 (polar p3 winkel (/ (distance P3 P2) 2 )))		;
  	)

     (setq p5 (polar m1 winpl90 d2))						;
     (if (or
         (and (and (> winkel (* pi 0.5)) (<= winkel (* pi 1.5))) (= ort "J"))       
         (and (or (<= winkel (* pi 0.5)) (> winkel (* pi 1.5))) (/= ort "J"))
         )
         (setq p5 (polar m1 winmi90 d2))						;
     )
     (setq th (/ dicke 3.0))							;
         (if (< dicke 6.0)
             (setq th 2.5)
         )
         (if (and (>= dicke 6.0) (< dicke 9.0))
             (setq th 3.0)
         )
         (if (> dicke 15.0)
             (setq th 5.0)
         )
  
     (setq kzgr (strcase kzz))							;
     (setq rohd (itoa rohdicke))						;
     (setq bez (strcat kzgr "(" rohd ")"))					;
  
     (command "stil" "arial.ttf" "arial.ttf" "0.00" "" "" "" "" "")		;

     (command "LAYER" "M" "LT-Text" "FA" "2" "LT-Text" "")
     (command "LAYER" "LT" "CONTINUOUS" "" "")
  
     (command "text" "I" "mz" p5 th w bez)					;
)

;--------------------------------------------------------
; Funktion Zeichnung auf Grenzen zoomen
;--------------------------------------------------------

(defun zogr ()
	(command "_zoom" "fe" P1 epf)						;
  	(command "_zoom" "fa" ".95xp")
)
(princ)

;--------------------------------------------------------
; Schraffur zeichnen / Furnierlienien zeichnen
;--------------------------------------------------------

(defun schraff1 ()
     (setq mstab (* 0.16 dicke))
     (setq mst2 (/ (* 4.0 anl) 15))
     (setq win (+ w 45.0))
     (setq spf (polar sp winpl135 0.01))
     (setq epf (polar ep winpl45 0.01))              
     (setq p1f (polar p1 winmi135 0.01))     
     (setq p2f (polar p2 winmi45 0.01))      
     (setq p3f (polar p3 winmi45 0.01))                  
     (setq p4f (polar p4 winpl45 0.01))     
     (setq p3ff (polar p3 winmi135 0.01))     
     (setq p4ff (polar p4 winpl135 0.01))
  
     (if  (or
          (and (and (> winkel (* pi 0.5)) (<= winkel (* pi 1.5))) (= ort "J"))           
          (and (or (<= winkel (* pi 0.5)) (> winkel (* pi 1.5))) (/= ort "J"))
          )
         (progn
         (setq spf (polar sp winmi135 0.01))
         (setq epf (polar ep winmi45 0.01))              
         (setq p1f (polar p1 winpl135 0.01))     
         (setq p2f (polar p2 winpl45 0.01))      
         (setq p3f (polar p3 winpl45 0.01))                  
         (setq p4f (polar p4 winmi45 0.01))     
         (setq p3ff (polar p3 winpl135 0.01))     
         (setq p4ff (polar p4 winmi135 0.01))     
         )
     )

     (command "LAYER" "M" "LT-Schraffur" "FA" "41" "LT-Schraffur" "")
     (command "LAYER" "LT" "CONTINUOUS" "" "")  

     (command "schraff" "plasti" mst2 win px "")
     (command "schraff" "ansi31" mstab win "fp" p4ff p3ff p2f epf "" "")

  
     (setq p9 (polar sp winmi90 1))     
     (setq p6 (polar p1 winpl90 1))         
     (if (or
          (and (and (> winkel (* pi 0.5)) (<= winkel (* pi 1.5))) (= ort "J"))     
          (and (or (<= winkel (* pi 0.5)) (> winkel (* pi 1.5))) (/= ort "J"))
          )
         (progn
         (setq p9 (polar sp winpl90 1))     
         (setq p6 (polar p1 winmi90 1))         
         )
     )
     (setq p10 (polar p9 winkel (+ 10 dicke)))
     (setq p11 (polar p9 winkel anl))
     (setq p7 (polar p6 winkel (+ 10 dicke)))
     (setq p8 (polar p6 winkel anl))

     (command "LAYER" "M" "LT-B" "FA" "3" "LT-B" "")	
     (command "LAYER" "LT" "CONTINUOUS" "" "")
  
         (if (or (= ueber "J") (= ueber "j"))
             (progn
                (command "linie" p9 p10 "")
                (command "linie" p6 p7 "")
             )
             (progn
                (command "linie" p11 p10 "")
                (command "linie" p8 p7 "")
             )
         )

           (if (or (= zomgr "J") (= zomgr "j"))
             (progn (zogr)))
  
)

;--------------------------------------------------------
; Hauptprogramm
;--------------------------------------------------------

(defun c:dr_platte_a ( / sp ep ort laenge rohdicke dicke winkel ueber winpl45 winpl90 winpl135 winpl180 winmi45 winmi90 winmi135 w kzz roh
			an anl ueb abb p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 px d2 d3 l2 l4 m1 th kzgr rohd bez mstab mst2 win num spf epf p1f p2f p3f p4f p3ff p4ff kzeichen)

      (setq balt (getvar "blipmode"))
      (setq calt (getvar "cmdecho"))
      (setq lalt (getvar "clayer"))
      (setq ofangalt (getvar "osmode"))
      (setvar "cmdecho" 0) 
      (setvar "blipmode" 0)
;
      (setq abb "1")							;
;
      (princ "\n ")
      (princ "\nEine beschichtete Platte mit Massivholzkante wird gezeichnet:")
      (plmasse1)							;
;
  	(if (or (= an "") (= an "0"))					;
            (setq abb "0")						;
        )
;
      (punkte1)								;
;
      (if (= abb "1")
          (progn
            (setvar "osmode" 0)
;
            (umriss1)							;
;
            (setq kzeichen (substr kzz 1 1))				;
            (if (not (or (= kzeichen "") (= kzeichen " ")))		;
                (textbez1)
            )
;
            (schraff1)						;
          )
          (Prompt "\n***Abbruch***")
      )
;
      (command "layer" "se" lalt "")
      (setvar "blipmode" balt)
      (setvar "cmdecho" calt)
      (setvar "osmode" ofangalt)
      (princ "\n Copyright (c) 2o24 Dieter Ribbrock.")
      (princ "\n Das Programm dr_platte_a.lsp ist geladen. Mit Eingabe dr_platte_a und RETURN starten.")
      (princ)
)

