;	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_gespufa.lsp - erstellt: 19.03.2025 F.u.J Ribbrock
;	http://www.ribbrock-online.de
;	Mit dem Programm kann eine unverleimte Vollholzbreitenverbindung mit gegespundeten Fugen und 45 ° Fasen hergestellt werden.
;	Aufruf:	fr_bv_gespufa
;
;	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		Federlänge/Nuttiefe
;	D3		Nutbreite (fest 1/3 D1)
;	Fa1		Fase

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

;
;--------------------------------------------------------------------------------
; Unterprogramme f0 bis f2
;--------------------------------------------------------------------------------
(defun f0 ()										;
	(setq PP (getpoint "\nGeben Sie den Platzierpunkt an:"))			;

	(setq P1 (polar PP (aib 0) Lm))							;
	(setq P2 (polar P1 (aib 270) (/ D1 2)))						;
	(setq P3 (polar P2 (aib 0) D2))							;

  	(setq P4 (polar P3 (aib 270) (/ D1 4)))						;
	(setq P5 (polar P4 (aib 180) D2))						;
  	(setq P6 (polar P5 (aib 270) (/ D1 4)))						;
    	(setq P7 (polar P6 (aib 180) Lm))						;

  	(setq P20 (polar P1 (aib 180) Fa1))						;
  	(setq P21 (polar P1 (aib 270) Fa1))
  
      	(setq PT1 (polar PP (angle PP P6) (/ (distance PP P6)2)))			;
  
  	(setq PS1 (polar P2 (aib 180) 5))						;

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

 	(command "PLinie" PP P20 P21 P2 P3 P4 P5 P6 P7 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 P20 P21 P2 P3 P4 P5 P6 P7 PP "")(setq PL1 (entlast))  	;
  
	(command "-schraff" "ei" "plasti" ScA ScW PS1 "")    				;

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

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

	(setq P1 (polar PP (aib 0) Lm))							;
	(setq P2 (polar P1 (aib 270) (/ D1 2)))						;
	(setq P3 (polar P2 (aib 0) D2))							;

  	(setq P4 (polar P3 (aib 270) (/ D1 4)))						;
	(setq P5 (polar P4 (aib 180) D2))						;
  	(setq P6 (polar P5 (aib 270) (/ D1 4)))						;
    	(setq P7 (polar P6 (aib 180) Lm))						;

  	(setq P20 (polar P1 (aib 180) Fa1))						;
  	(setq P21 (polar P1 (aib 270) Fa1))
  
  	(setq P8 (polar P7 (aib 90) (/ D1 4)))						;
  	(setq P9 (polar P8 (aib 0) D2))							;
	(setq P10 (polar P9 (aib 0) 1))							;
  	(setq P11 (polar P10 (aib 90) (/ D1 4)))					;

  	(setq P12 (polar P11 (aib 180) 1))						;
    	(setq P13 (polar P12 (aib 180) D2))						;

    	(setq P22 (polar PP (aib 0) Fa1))						;
  	(setq P23 (polar PP (aib 270) Fa1))
    
      	(setq PT1 (polar PP (angle PP P6) (/ (distance PP P6)2)))			;
  
  	(setq PS1 (polar P2 (aib 180) 5))						;
  
 	(command "LAYER" "M" "LT-A" "FA" "7" "LT-A" "")
	(command "LAYER" "LT" "CONTINUOUS" "" "")

  	(command "PLinie" P22 P20 P21 P2 P3 P4 P5 P6 P7 P8 P10 P11 P13 P23 P22 "")			;


    	(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" P22 P20 P21 P2 P3 P4 P5 P6 P7 P8 P10 P11 P13 P23 P22 "")(setq PL1 (entlast))  	;
  
	(command "-schraff" "ei" "plasti" ScA ScW PS1 "")   				;
  
  	(if (= Zog 1) (progn (zogr)))

	(command "_.erase" PL1 "")                          				;

)							   ;
;-------------------------------------------------------------------------
(defun f2 ()										;
	(setq PP (getpoint "\nGeben Sie den Platzierpunkt an:"))			;

	(setq P1 (polar PP (aib 0) Lm))							;
	(setq P2 (polar P1 (aib 270) (/ D1 2)))						;
	(setq P3 (polar P2 (aib 0) D2))							;

  	(setq P4 (polar P3 (aib 270) (/ D1 4)))						;
	(setq P5 (polar P4 (aib 180) D2))						;
  	(setq P6 (polar P5 (aib 270) (/ D1 4)))						;
    	(setq P7 (polar P6 (aib 180) Lm))						;

  	(setq P8 (polar P7 (aib 90) (/ D1 4)))						;
  	(setq P9 (polar P8 (aib 0) D2))							;
	(setq P10 (polar P9 (aib 0) 1))							;
  	(setq P11 (polar P10 (aib 90) (/ D1 4)))					;

  	(setq P12 (polar P11 (aib 180) 1))						;
    	(setq P13 (polar P12 (aib 180) D2))						;

      	(setq P22 (polar PP (aib 0) Fa1))						;
  	(setq P23 (polar PP (aib 270) Fa1))
    
      	(setq PT1 (polar PP (angle PP P6) (/ (distance PP P6)2)))			;
  
  	(setq PS1 (polar P2 (aib 180) 5))						;
  
 	(command "LAYER" "M" "LT-A" "FA" "7" "LT-A" "")
	(command "LAYER" "LT" "CONTINUOUS" "" "")

  	(command "PLinie" P22 P1 P6 P7 P8 P10 P11 P13 P23 P22 "")			;

    	(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" P22 P1 P6 P7 P8 P10 P11 P13 P23 P22 "")(setq PL1 (entlast))  	;
  
	(command "-schraff" "ei" "plasti" ScA ScW PS1 "")   				;
  
  	(if (= Zog 1) (progn (zogr)))

	(command "_.erase" PL1 "")                          				;
  
)							   ;
;-------------------------------------------------------------------------
;
;
(defun zogr ()
	(command "_zoom" "fe" P7 P1)							;
  	(command "_zoom" "fa" ".80xp")
)
(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_gespufa(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_gespufa(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_gespufa(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_gespufa(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_gespufa(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_GESPUFA.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_gespufa(dia" lb_frbrvb ")"))
(end_image)
  
(start_image "LOGO")								;
(slide_image 25 5 150 100 "fr_bv_gespufa(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 "DFa1" (rtos Fa1 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 "DFa1" "(setq Fa1 (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" 1)				;
			(setq D3 (/ D1 3))
			(set_tile "DD3" (rtos D3 2 3))				;
  		      ))
  (if (= bildwahl "1")(progn (mode_tile "DD3" 1)				;
			(setq D3 (/ D1 3))
			(set_tile "DD3" (rtos D3 2 3))
			))
  (if (= bildwahl "2")(progn (mode_tile "DD3" 1)				;
			(setq D3 (/ D1 3))					;
			(set_tile "DD3" (rtos D3 2 3))
			))

)

;-------------------------------------------------------------------------
;
(defun c:fr_bv_gespufa ( / PP P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 P11 P12 P13 P20 P21 P22 P23 PS1 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 Fa1 Lm ScA ScW liste listenelemente)
 
  	(setq Lm 100)	;
  
  	(setq D1 18)	;
	(setq D2 8)	;

 	(setq D3 (/ D1 3))
    	(setq Fa1 4)	;

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

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

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