;	Für AutoCAD Version 2023
;	Nicht getestet unter ältern Versionen, in denen kann es aufgrund von internen
;	Befehls-Änderungen zu unerwarteten Reaktionen kommen.
;	Dateiname: fr_bv_falz.lsp - erstellt: 13.02.2024 F. Ribbrock
;	http://www.ribbrock-online.de
;	Mit dem Programm kann eine unverleimte Vollholzbreitenverbindung mit überfälzter Fuge konstruiert werden.
;	Aufruf:	fr_bv_falz
;
;	Das Programm wird dem Benutzer - "in dieser,seiner Form" - zur Verfügung gestellt.
;	Für eventuelle Programmfehler oder Schäden durch die Anwendung wird keine Haftung übernommen.
;
;	Erforderliche Eingaben:
;	PP		Platzierpunkt <Punkt> <PP> = siehe Markierungen in Dias

;	Lm		Brettbreite
;	D1		Brettdicke
;	D2		Falzlänge (FalL)
;	D3		Falzhöhe (FalH)

;	KZ		Vollholz Kurzbezeichnung
;	ScA		PLASTI Schraffurabstand
;	ScW		PLASTI Schraffurwinkel 45/135

;
;--------------------------------------------------------------------------------
; Unterprogramme f0 bis f2 zur individuellen Brettausführung (links-mitte-rechts)
;--------------------------------------------------------------------------------
(defun f0 ()										; 
	(setq PP (getpoint "\nGeben Sie den Platzierpunkt an:"))

	(setq P1 (polar PP (aib 0) Lm))							; 
	(setq P2 (polar P1 (aib 270) D1))						; 
	(setq P3 (polar P2 (aib 180) Lm))						; 

	(setq P10 (polar P1 (aib 180) D2))						; 
	(setq P11 (polar P10 (aib 270) D3))						; 
	(setq P12 (polar P11 (aib 0) D2))						; 

	(setq P13 (polar P3 (aib 0) D2))						; 
	(setq P14 (polar P13 (aib 90) D3))						; 
	(setq P15 (polar P14 (aib 180) D2))						; 
    
      	(setq PT1 (polar PP (angle PP P2) (/ (distance PP P2)2)))			; 
  
  	(setq PS1 (polar P11 (aib 180) 5))						; 

 	(command "LAYER" "M" "LT-A" "FA" "7" "LT-A" "")
	(command "LAYER" "LT" "CONTINUOUS" "" "")

  	(command "PLinie" PP P10 P11 P12 P2 P3 PP "")					; 

    	(command "LAYER" "M" "LT-Text" "FA" "2" "LT-Text" "")				; 
	(command "LAYER" "LT" "CONTINUOUS" "" "")
      	(command "text" "I" "mz" PT1 "2.5" "0" KZ)					; 

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

	(command "PLinie" PP P10 P11 P12 P2 P3 PP "")(setq PL1 (entlast))  		; 
  
	(command "-schraff" "ei" "plasti" ScA ScW PS1 "")    				; 

  	(if (= Zog 1) (progn (zogr)))

	(command "_.erase" PL1 "")                       				; 
  
)							   ; Ende defun f0
;-------------------------------------------------------------------------
(defun f1 ()										; 
	(setq PP (getpoint "\nGeben Sie den Platzierpunkt an:"))

	(setq P1 (polar PP (aib 0) Lm))							;  
	(setq P2 (polar P1 (aib 270) D1))						;  
	(setq P3 (polar P2 (aib 180) Lm))						;  

	(setq P10 (polar P1 (aib 180) D2))						;  
	(setq P11 (polar P10 (aib 270) D3))						;  
	(setq P12 (polar P11 (aib 0) D2))						;  

	(setq P13 (polar P3 (aib 0) D2))						;  
	(setq P14 (polar P13 (aib 90) D3))						;  
	(setq P15 (polar P14 (aib 180) D2))						;  
    
      	(setq PT1 (polar PP (angle PP P2) (/ (distance PP P2)2)))			; 
  
  	(setq PS2 (polar P14 (aib 0) 5))						; 

 	(command "LAYER" "M" "LT-A" "FA" "7" "LT-A" "")
	(command "LAYER" "LT" "CONTINUOUS" "" "")

  	(command "PLinie" PP P10 P11 P12 P2 P13 P14 P15 PP "")				; 

    	(command "LAYER" "M" "LT-Text" "FA" "2" "LT-Text" "")				; 
	(command "LAYER" "LT" "CONTINUOUS" "" "")
      	(command "text" "I" "mz" PT1 "2.5" "0" KZ)					; 

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

	(command "PLinie" PP P10 P11 P12 P2 P13 P14 P15 PP "")(setq PL1 (entlast))  	; 
  
	(command "-schraff" "ei" "plasti" ScA ScW PS2 "")   				; 

  	(if (= Zog 1) (progn (zogr)))

	(command "_.erase" PL1 "")                          				; 
  
)							   ; Ende defun f1
;-------------------------------------------------------------------------
(defun f2 ()										; 
	(setq PP (getpoint "\nGeben Sie den Platzierpunkt an:"))

	(setq P1 (polar PP (aib 0) Lm))							;  
	(setq P2 (polar P1 (aib 270) D1))						;  
	(setq P3 (polar P2 (aib 180) Lm))						;  

	(setq P10 (polar P1 (aib 180) D2))						;  
	(setq P11 (polar P10 (aib 270) D3))						;  
	(setq P12 (polar P11 (aib 0) D2))						;  

	(setq P13 (polar P3 (aib 0) D2))						;  
	(setq P14 (polar P13 (aib 90) D3))						;  
	(setq P15 (polar P14 (aib 180) D2))						;  
    
      	(setq PT1 (polar PP (angle PP P2) (/ (distance PP P2)2)))			; 
  
  	(setq PS3 (polar P11 (aib 180) 5))						; 

 	(command "LAYER" "M" "LT-A" "FA" "7" "LT-A" "")
	(command "LAYER" "LT" "CONTINUOUS" "" "")

  	(command "PLinie" PP P1 P2 P13 P14 P15 PP "")					; 

    	(command "LAYER" "M" "LT-Text" "FA" "2" "LT-Text" "")				; 
	(command "LAYER" "LT" "CONTINUOUS" "" "")
      	(command "text" "I" "mz" PT1 "2.5" "0" KZ)					; 

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

	(command "PLinie" PP P1 P2 P13 P14 P15 PP "")(setq PL1 (entlast))  		; 
  
	(command "-schraff" "ei" "plasti" ScA ScW PS3 "")   				; 

  	(if (= Zog 1) (progn (zogr)))

	(command "_.erase" PL1 "")                          				; 
  
)							   ; Ende defun f2
;-------------------------------------------------------------------------
;
;
(defun zogr ()
	(command "_zoom" "fe" P3 P1)							; 
  	(command "_zoom" "fa" ".95xp")
)
(princ)
;-------------------------------------------------------------------------
;
;
(defun aib (w)
	(* Pi (/ w 180.0))
)
;-------------------------------------------------------------------------
;
(defun ausfuehrung ()
	(setq cealt (getvar "CMDECHO"))		; 
	(setq mealt (getvar "MENUECHO"))	; 
	(setq layalt (getvar "CLAYER"))		; 
	(setq bpm (getvar "BLIPMODE"))		; 
 	(setq osm (getvar "OSMODE"))		; 
	(setq pdm (getvar "PDMODE"))		; 
	(setvar "CMDECHO" 0)
	(setvar "MENUECHO" 0)
	(setvar "OSMODE" 0)
	(setvar "BLIPMODE" 0)
  	(setvar "PDMODE" 3)
  
; 
  
 (if (= bildwahl "0")(progn (f0)))
 (if (= bildwahl "1")(progn (f1)))
 (if (= bildwahl "2")(progn (f2)))

;
 (setq ja nil)
 (altsave)  
)
;
;-------------------------------------------------------------------------
;
(defun *error* (emsg)
	(princ emsg)
	(altsave)
	(princ)
)
;
;-------------------------------------------------------------------------

(defun altsave ()
	(command "Layer" "SE" layalt "")
	(setvar "CMDECHO" cealt)
	(setvar "MENUECHO" mealt)
	(setvar "BLIPMODE" bpm)
	(setvar "OSMODE" osm)
  	(setvar "PDMODE" pdm)
)
;-------------------------------------------------------------------------

(defun listbox ()
(schalter)										; 
(setq lb_frbrvb (get_tile "lb"))
(setq breite (dimx_tile "bild"))
(setq hoehe (dimy_tile "bild"))
(start_image "bild")
(fill_image 0 0 breite hoehe -2)
(slide_image 0 0 breite hoehe (strcat "fr_bv_falz(dia" lb_frbrvb ")"))			; 
(end_image)
)
;-------------------------------------------------------------------------

(defun imagebutton_unten ()
(setq isd_string (get_tile "lb"))
(setq isd_integer (atoi isd_string))
(setq isd_integer_next_string (itoa (+ isd_integer 1)))
(set_tile "lb" isd_integer_next_string)
(setq breite (dimx_tile "bild"))
(setq hoehe (dimy_tile "bild"))
(start_image "bild")
(fill_image 0 0 breite hoehe -2)
(slide_image 0 0 breite hoehe (strcat "fr_bv_falz(dia" isd_integer_next_string ")"))
(end_image)
  
(if (= isd_integer (- listenelemente 1))
 (progn
 (set_tile "lb" "0")									; 
 (start_image "bild")
 (fill_image 0 0 breite hoehe -2)
 (slide_image 0 0 breite hoehe "fr_bv_falz(dia0)")					; 
 (end_image)
 )
)
(setq lb_frbrvb (get_tile "lb"))							; 
(schalter)
)
;-------------------------------------------------------------------------

(defun imagebutton_oben ()
(setq isd_string (get_tile "lb"))							; 
(setq isd_integer (atoi isd_string))
(setq isd_integer_next_string (itoa (- isd_integer 1)))
(set_tile "lb" isd_integer_next_string)							; 
(setq breite (dimx_tile "bild"))
(setq hoehe (dimy_tile "bild"))
(start_image "bild")
(fill_image 0 0 breite hoehe -2)
(slide_image 0 0 breite hoehe (strcat "fr_bv_falz(dia" isd_integer_next_string ")"))
(end_image)
  
(if (= isd_integer 0)
 (progn
 (set_tile "lb" (itoa (- listenelemente 1)))						; 
 (start_image "bild")
 (fill_image 0 0 breite hoehe -2)
 (slide_image 0 0 breite hoehe (strcat "fr_bv_falz(dia" (itoa (- listenelemente 1)) ")"))
 (end_image)
 )
)
(setq lb_frbrvb (get_tile "lb"))							; 
(schalter)
)											; 
;-------------------------------------------------------------------------

(defun pickpunkt (y)
(setq halbe_hoehe (/ (dimy_tile "bild") 2.0))
(if (> y halbe_hoehe)
 (imagebutton_unten))
(if (< y halbe_hoehe)
(imagebutton_oben))
)											; 
;-------------------------------------------------------------------------

(defun okay ()
(setq bildwahl (get_tile "lb"))								; 
(setq ja (done_dialog 1))
)
;-------------------------------------------------------------------------
;Unterprogramm ABBRUCH (wird ausgeführt wenn Abbrechen-Button gedrückt wurde)
(defun abbruch ()
(done_dialog 0)
)
;-------------------------------------------------------------------------

(defun dcl_box ()
(setq dcl_kennzahl (load_dialog "FR_BV_FALZ.dcl"))				; 
(setq nd (new_dialog "fr_brvb" dcl_kennzahl))

;
(start_list "lb" 3)								; 
(mapcar 'add_list liste)							; 
(end_list)

;
(setq lb_frbrvb "0")								; 
(set_tile "lb" lb_frbrvb)

(setq breite (dimx_tile "bild"))
(setq hoehe (dimy_tile "bild"))
(start_image "bild")
(fill_image 0 0 breite hoehe -2)
(slide_image 0 0 breite hoehe (strcat "fr_bv_falz(dia" lb_frbrvb ")"))
(end_image)
  
(start_image "LOGO")								; 
(slide_image 25 5 150 100 "fr_bv_falz(logo)")					; 
(end_image)

(set_tile "DLm" (rtos Lm 2 0))							; 
  
(set_tile "DD1" (rtos D1 2 0))							; 
(set_tile "DD2" (rtos D2 2 0))							; 
(set_tile "DD3" (rtos D3 2 0))							; 

(setq KZ (get_tile "DKZ"))							; 

(set_tile "DScA" (rtos ScA 2 2))						; 
(set_tile "DScW" (rtos ScW 2 0))						; 

(set_tile "DZog" (rtos Zog 2 0))						; 
(setq Zog (atoi (get_tile "DZog")))						; 

(action_tile "DLm" "(setq Lm (atof $value))")
  
(action_tile "DD1" "(setq D1 (atof $value))")					;
(action_tile "DD2" "(setq D2 (atof $value))")
(action_tile "DD3" "(setq D3 (atof $value))")

(action_tile "DKZ" "(do_txt)")
  
(action_tile "DScA" "(setq ScA (atof $value))")  				; 
(action_tile "DScW" "(setq ScW (atof $value))")  				; 

(action_tile "DZog" "(setq Zog (atoi $value))") 				;
  
(action_tile "lb" "(listbox)")
(action_tile "bild" "(pickpunkt $y)")
(action_tile "cancel" "(abbruch)")
(action_tile "accept" "(okay)")

(start_dialog)									;
(unload_dialog dcl_kennzahl)							;
)										;
;------------------------------------------------
(defun do_txt ()								; 
  (setq KZ (get_tile "DKZ"))
)  
;-------------------------------------------------------------------------
(defun schalter ()
(setq bildwahl (get_tile "lb"))
  (if (= bildwahl "0")(progn (mode_tile "DD3" 0)				; 
			(setq D3 10)
			(set_tile "DD3" (rtos D3 2 0))
  		      ))
  (if (= bildwahl "1")(progn (mode_tile "DD3" 0)				; 
			(setq D3 10)
			(set_tile "DD3" (rtos D3 2 0))
			))
  (if (= bildwahl "2")(progn (mode_tile "DD3" 0)				; 
			(setq D3 10)						; 
			(set_tile "DD3" (rtos D3 2 0))
			))

)

;-------------------------------------------------------------------------
;Hauptprogramm
(defun c:fr_bv_falz ( / PP P1 P2 P3 P10 P11 P12 P13 P14 P15 PS1 PS2 PS3 PT1
			cealt mealt layalt bpm osm pdm ja lb_frbrvb breite hoehe isd_string isd_integer isd_integer_next_string halbe_hoehe bildwahl
			dcl_kennzahl nd Zog KZ D1 D2 D3 Lm ScA ScW liste listenelemente)
 
  	(setq Lm 100)	;
  
  	(setq D1 20)	;
	(setq D2 10)	;
	(setq D3 10)	;

  	(setq ScA 1.5)	;
  	(setq ScW 45)	;
  
  	(setq Zog 0)	;
  
; 
(setq liste (list "Linkes Endbrett - Falz rechts" "Mittelbrett - Falz beidseitig" "Rechtes Endbrett - Falz links"))
  
(setq listenelemente (length liste))			; 
(dcl_box)						; 

(if (/= ja nil)	(ausfuehrung))				; 
(redraw)						; 
(princ)
)							; 

(princ "\n Copyright (c) 2o24 F. Ribbrock.")
(princ "\n Das Programm fr_bv_falz.lsp ist geladen. Mit Eingabe fr_bv_falz und RETURN starten.")
(princ)
