;	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-run.lsp - erstellt: 13.06.2024 F. Ribbrock / J. Ribbrock
;	
;	Mit dem Programm kann eine unverleimte Vollholzbreitenverbindung mit überfälzter Fuge und Rundung konstruiert werden.
;	Aufruf:	fr_bv_falz-run
;
;	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)
;	Ru1		Rundung

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

;
;--------------------------------------------------------------------------------
; 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 90) D3))						; 
	(setq P2 (polar P1 (aib 270) D1))						; 
	(setq P3 (polar P2 (aib 180) Lm))						; 
  	(setq P4 (polar P3 (aib 90) D1))						; 

	(setq P20 (polar P1 (aib 180) D2))						; 
	(setq P21 (polar P20 (aib 270) D3))						; 

	(setq P30 (polar P4 (aib 0) Ru1))						; 
	(setq P31 (polar P4 (aib 270) Ru1))						; 
	(setq P32 (polar P20 (aib 180) Ru1))						; 
	(setq P33 (polar P20 (aib 270) Ru1))						; 
  
      	(setq PT1 (polar P4 (angle P4 P2) (/ (distance P4 P2)2)))			; 
  
  	(setq PS1 (polar P21 (aib 180) 5))						; 

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

  	(command "PLinie" PP P2 P3 P31 "K" "RA" Ru1 "W" -90 P30 "L" P32 "K" "RA" Ru1 "W" -90 P33 "L" P21 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 P2 P3 P31 "K" "RA" Ru1 "W" -90 P30 "L" P32 "K" "RA" Ru1 "W" -90 P33 "L" P21 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 90) D3))						; 
	(setq P2 (polar P1 (aib 0) Lm))							; 
	(setq P3 (polar P2 (aib 270) D1))						; 
  	(setq P4 (polar P3 (aib 180) Lm))						; 

	(setq P20 (polar P2 (aib 180) D2))						; 
	(setq P21 (polar P20 (aib 270) D3))						; 
	(setq P22 (polar P21 (aib 0) D2))						; 

	(setq P23 (polar P4 (aib 0) D2))						; 
	(setq P24 (polar P23 (aib 90) D3))						; 

	(setq P30 (polar P1 (aib 0) Ru1))						; 
	(setq P31 (polar P1 (aib 270) Ru1))						; 
	(setq P32 (polar P20 (aib 180) Ru1))						; 
	(setq P33 (polar P20 (aib 270) Ru1))						; 
    
      	(setq PT1 (polar P1 (angle P1 P3) (/ (distance P1 P3)2)))			; 
  
  	(setq PS2 (polar P24 (aib 0) 5))						; 

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

 	(command "PLinie" PP P31 "K" "RA" Ru1 "W" -90 P30 "L" P32 "K" "RA" Ru1 "W" -90 P33 "L" P21 P22 P3 P23 P24 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 P31 "K" "RA" Ru1 "W" -90 P30 "L" P32 "K" "RA" Ru1 "W" -90 P33 "L" P21 P22 P3 P23 P24 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 270) D3))						; 
	(setq P2 (polar P1 (aib 0) Lm))							; 
	(setq P3 (polar P2 (aib 90) D1))						; 
  	(setq P4 (polar P3 (aib 180) Lm))						; 

	(setq P20 (polar P1 (aib 0) D2))						; 
	(setq P21 (polar P20 (aib 90) D3))						; 

	(setq P30 (polar P4 (aib 0) Ru1))						; 
	(setq P31 (polar P4 (aib 270) Ru1))						; 
	(setq P32 (polar P3 (aib 180) Ru1))						; 
	(setq P33 (polar P3 (aib 270) Ru1))						; 
    
      	(setq PT1 (polar P4 (angle P4 P2) (/ (distance P4 P2)2)))			; 
  
  	(setq PS2 (polar P21 (aib 0) 5))						; 

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

  	(command "PLinie" PP P31 "K" "RA" Ru1 "W" -90 P30 "L" P32 "K" "RA" Ru1 "W" -90 P33 "L" P2 P20 P21 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 P31 "K" "RA" Ru1 "W" -90 P30 "L" P32 "K" "RA" Ru1 "W" -90 P33 "L" P2 P20 P21 PP "")(setq PL1 (entlast))  	; 
  
	(command "-schraff" "ei" "plasti" ScA ScW PS2 "")   				; 

  	(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-run(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-run(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-run(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-run(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-run(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))
)
;-------------------------------------------------------------------------
;
(defun abbruch ()
(done_dialog 0)
)
;-------------------------------------------------------------------------
;
(defun dcl_box ()
(setq dcl_kennzahl (load_dialog "FR_BV_FALZ-RUN.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-run(dia" lb_frbrvb ")"))
(end_image)
  
(start_image "LOGO")								; 
(slide_image 25 5 150 100 "fr_bv_falz-run(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))							; 
(set_tile "DRu1" (rtos Ru1 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 "DRu1" "(setq Ru1 (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))
			))
)
;
;-------------------------------------------------------------------------
;
(defun c:fr_bv_falz-run ( / PP P1 P2 P3 P4 P20 P21 P22 P23 P24 P30 P31 P32 P33 PS1 PS2 PT1 PL1
			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 Ru1 Lm ScA ScW liste listenelemente)
 
  	(setq Lm 100)	; 
  
  	(setq D1 20)	; 
	(setq D2 10)	; 
	(setq D3 10)	; 
  	(setq Ru1 4)	; 

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

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

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