;;;  Dateiname: R-Tisch.lsp  -  erstellt: Thomas Elbracht
;;;  9.2022  -  für AC2023               mail: te@elbracht-web.de
;;;  Aufruf mit: R-Tisch
;;;
;;;  Die Routine erstellt einen runden Beistelltisch für den Einrichtungsplaner
;;;
;;;  Das Programm wird dem Benutzer so zur Verfügung gestellt, "wie es ist".
;;;  Für eventuelle Programmfehler oder Schäden durch die Anwendung
;;;  wird keine Haftung übernommen.
;;
  (defun Te:R-TischIni ()
  ; speichert die Variablen
  (if *error*				
    (setq *te:error* *error*)		
  )

  (setq cealt (getvar "CMDECHO")
        mealt (getvar "MENUECHO")
	osalt (getvar "OSMODE")
	ortalt (getvar "ORTHOMODE")
	layalt (getvar "CLAYER")
	coalt (getvar "CECOLOR")
	)
  
  	(setvar "CMDECHO" 0)
	(setvar "MENUECHO" 0)
  	(setvar "OSMODE" 0)
      	(setvar "ORTHOMODE" 0)
 
  (defun *error* (sTxt)	
    (princ (strcat "\n" sTxt))

  (setvar "CMDECHO" cealt)
  (setvar "MENUECHO" mealt)
  (setvar "OSMODE" osalt)
  (setvar "ORTHOMODE" ortalt)
  (setvar "CECOLOR" coalt)
    
    (if	*te:error*
      (setq *error* *te:error*)	
      (setq *error* nil)
    )
    (princ)
  )
nil
)
(defun Te:R-TischDlg ()

(setq next 4)
(setq	IMG1 "r-tisch(logo)"
	fil1 IMG1
  ) 
(if (not dcl_id) (setq dcl_id (load_dialog "r-tisch")))

  (while (> next 1)
  (new_dialog "rtisch" dcl_id)

	(setq brei (dimx_tile "DIA"))
    	(setq hoe (dimy_tile "DIA"))
    	(start_image "DIA")
    	(fill_image 0 0 brei hoe -2)
    	(slide_image -20 -10 600 400 "r-tisch(r-tisch-3s)")
	(end_image)
 
    (start_image "IMG1") 
    (slide_image 180 -40 180 130 fil1)
    (end_image)
    (set_tile "DTDu" (rtos TDu 2 0))
    (set_tile "DTH" (rtos TH 2 0))
    (set_tile "DTD" (rtos TD 2 0))
    (set_tile "DTUE" (rtos TUE 2 0))
    (set_tile "DFuDo" (rtos FuDo 2 0))
    (set_tile "DFuDu" (rtos FuDu 2 0))
    (set_tile "DFuSr" (rtos FuSr 2 0))
    (set_tile "DFusEu" (rtos FusEu 2 0))
    (set_tile "DZaH" (rtos ZaH 2 0))
    (set_tile "DZaD" (rtos ZaD 2 2))
    (set_tile "DZAb" (rtos ZAb 2 2))
    (if (= AnzFu 3) (progn(set_tile "DAnzFu0" "1")(set_tile "DAnzFu1" "0")))
    (if (= AnzFu 4) (progn(set_tile "DAnzFu0" "0")(set_tile "DAnzFu1" "1")))
    (if (= FusS 1) (progn(set_tile "DFusS" "1")(set_tile "DFusG" "0")(mode_tile "DTUE" 1)(mode_tile "DFuSr" 0)(mode_tile "DFusEu" 0)))
    (if (= FusS 0) (progn(set_tile "DFusS" "0")(set_tile "DFusG" "1")(mode_tile "DTUE" 0)(mode_tile "DFuSr" 1)(mode_tile "DFusEu" 1)))
    (action_tile "DTDu" "(setq TDu (atof $value))")
    (action_tile "DTH" "(setq TH (atof $value))")
    (action_tile "DTD" "(setq TD (atof $value))")
    (action_tile "DTUE" "(setq TUE (atof $value))")
    (action_tile "DFuDo" "(setq FuDo (atof $value))")
    (action_tile "DFuDu" "(setq FuDu (atof $value))")
    (action_tile "DFuSr" "(setq FuSr (atof $value))")
    (action_tile "DFusEu" "(setq FusEu (atof $value))")
    (action_tile "DZaH" "(setq ZaH (atof $value))")
    (action_tile "DZaD" "(setq ZaD (atof $value))")
    (action_tile "DAnzFu0" "(DO_AnzFu0 $value)")
    (action_tile "DAnzFu1" "(DO_AnzFu1 $value)")
    (action_tile "DFusS" "(DO_FusS $value)")
    (action_tile "DFusG" "(DO_FusG $value)")
    (action_tile "accept" "(done_dialog 1)")
    (action_tile "cancel" "(done_dialog 0)")
(setq next (start_dialog))
    
(if (= next 1) 
  (Te:R-TischZeich)
  (Te:R-TischBack)
  )
    )
  (unload_dialog dcl_id)
)
(defun Te:R-TischZeich ()
  (vl-load-com)
  (vl-cmdf "_.view" "S" "TE_VIEW")
  (vl-cmdf "_.UCS" "")
  (vl-cmdf "_.PLAN" "W")
  (setvar "CMDECHO" 0)

  (setq elayer "Te_R-Tisch")
  (vl-cmdf "_.LAYER" "_M"  elayer "_CO" "34" "" "")
 (setq EP (getpoint "\n Einfügepunkt angeben, Mitte Tisch  "))   
  (setvar "osmode" 0)

  (setq FuH (- TH TD)
	TDu2 (/ TDu 2.0)
	FuDu2 (/ FuDu 2.0)
	FuDo2 (/ FuDo 2.0)
	PlaEP (list (car EP)(cadr EP)(+(caddr EP)FuH))
	ZargiEP (list (car EP)(cadr EP)(-(caddr PlaEP)ZaH))
	ZargaEP ZargiEP
	)
    (if (= FusS 1)  (progn
  (setq ZargU (- TDu2 FusEu)
	CirUn (list (car EP)(+(-(cadr EP)ZargU) FuDu2) (caddr EP))
	CirOb (list (car EP)(+(-(cadr CirUn)FuDu2) FuDo2 FuSr)(+(caddr EP)FuH))
	ZargiD (- TDu2 FusEu FuSr FuDo2 (/ Zad 2.0))
	ZargaD (+ ZargiD Zad)
	 )
       )
    (progn
      (setq CirOb (list (car EP)(+(-(cadr EP)(- TDu2 TUE)) FuDo2)(+(caddr EP)FuH))
	    CirUn (list (car EP)(cadr CirOb) (caddr EP))	    
	    ZargaD (+(- TDu2 TUE FuDo2)(/ Zad 2.0))
	    ZargiD (- ZargaD Zad)
	    )
       )
  )
  
  (Te:Circ CirUn FuDu2)(setq CircU (entlast))
  (Te:Circ CirOb FuDo2)(setq CircO (entlast))

 (vl-cmdf "_loft" CircU CircO "" "")(setq LofFu (entlast))
 (vl-cmdf "_.ARRAY" LofFu "" "P" EP AnzFu "" "")

  (TE:Cyl ZargiEP ZargiD ZaH)(setq Zargi (entlast))
  (TE:Cyl ZargaEP ZargaD ZaH)(setq Zarga (entlast))
  (vl-cmdf "DIFFERENZ" Zarga "" Zargi "")
  (TE:Cyl PlaEP TDu2 TD)
  (vl-cmdf "_.view" "H" "TE_VIEW")
  (vl-cmdf "_.view" "LÖ" "TE_VIEW") 

)
(defun DO_FusS (in)
(setq FusS_VAL (atof in))
(if (and(= FusS_VAL 1)(= AnzFu 3))
  (progn (setq FusS 1)(set_tile "DFusS" "1")(set_tile "DFusG" "0")
		     (mode_tile "DTUE" 1)(mode_tile "DFuSr" 0)(mode_tile "DFusEu" 0) 
	     	(start_image "DIA") 
(fill_image 0 0 brei hoe -2)(slide_image -20 -10 600 400 "r-tisch(r-tisch-3s)")
		     (end_image)
		     ))
(if (and(= FusS_VAL 1)(= AnzFu 4))
  (progn (setq FusS 1)(set_tile "DFusS" "1")(set_tile "DFusG" "0")
		     (mode_tile "DTUE" 1)(mode_tile "DFuSr" 0)(mode_tile "DFusEu" 0)
	     	(start_image "DIA") 
(fill_image 0 0 brei hoe -2)(slide_image -20 -10 600 400 "r-tisch(r-tisch-4s)")
		     (end_image)
		     ))
)
(defun DO_FusG (in)
(setq FusG_VAL (atof in))
(if (and (= FusG_VAL 1)(= AnzFu 3))  (progn (setq FusS 0)(set_tile "DFusS" "0")(set_tile "DFusG" "1")
		     (mode_tile "DTUE" 0)(mode_tile "DFuSr" 1)(mode_tile "DFusEu" 1)
		     
	     	(start_image "DIA") 
(fill_image 0 0 brei hoe -2)(slide_image -20 -10 600 400 "r-tisch(r-tisch-3g)")
		     (end_image)
		     ))
(if (and (= FusG_VAL 1)(= AnzFu 4))  (progn (setq FusS 0)(set_tile "DFusS" "0")(set_tile "DFusG" "1")
		     (mode_tile "DTUE" 0)(mode_tile "DFuSr" 1)(mode_tile "DFusEu" 1)     
	     	(start_image "DIA") 
(fill_image 0 0 brei hoe -2)(slide_image -20 -10 600 400 "r-tisch(r-tisch-4g)")
		     (end_image)
		     ))
)
(defun DO_AnzFu0 (in)
(setq AnzFu_VAL (atof in))
(if (and (= AnzFu_VAL 1)(= FusS 0)) (progn (setq AnzFu 3)
		     (set_tile "DAnzFu0" "1")(set_tile "DAnzFu1" "0")
	     	(start_image "DIA") 
(fill_image 0 0 brei hoe -2)(slide_image -20 -10 600 400 "r-tisch(r-tisch-3g)")
		     (end_image)
		     ))
(if (and (= AnzFu_VAL 1)(= FusS 1)) (progn (setq AnzFu 4)
		     (set_tile "DAnzFu0" "1")(set_tile "DAnzFu1" "0")
	     	(start_image "DIA") 
(fill_image 0 0 brei hoe -2)(slide_image -20 -10 600 400 "r-tisch(r-tisch-3s)")
		     (end_image)
		     ))
) 
(defun DO_AnzFu1 (in)
(setq AnzFu_VAL (atof in))
(if (and (= AnzFu_VAL 1)(= FusS 0))  (progn (setq AnzFu 4)
		     (set_tile "DAnzFu0" "0")(set_tile "DAnzFu1" "1")
	     	(start_image "DIA") 
    (fill_image 0 0 brei hoe -2)(slide_image -20 -10 600 400 "r-tisch(r-tisch-4g)")
		     (end_image)
		     ) )
(if (and (= AnzFu_VAL 1)(= FusS 1))  (progn (setq AnzFu 4)
		     (set_tile "DAnzFu0" "0")(set_tile "DAnzFu1" "1")
	     	(start_image "DIA") 
    (fill_image 0 0 brei hoe -2)(slide_image -20 -10 600 400 "r-tisch(r-tisch-4s)")
		     (end_image)
		     ) )
)
(defun Te:Circ (CP rad)
    (setq circObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument circObj))
(setq ex (car CP)
	ey (cadr CP)
	ez (caddr CP))
  (setq PC (vlax-3d-point ex ey ez))
    (setq modelSpace (vla-get-ModelSpace doc))
    (setq circleObj (vla-AddCircle modelSpace PC rad))
)
(defun TE:Cyl (KnEP cylRad cylHoch)
    (setq cylObj (vlax-get-acad-object))
    (setq cylist (vla-get-ActiveDocument cylObj))
    (setq ex (car KnEP)
	ey (cadr KnEP)
	ez (+ (caddr KnEP) (/ cylHoch 2.0))
	)
  (setq PC (vlax-3d-point ex ey ez))
    (setq modelSpace (vla-get-ModelSpace cylist))
    (setq cyliObj (vla-AddCylinder modelSpace PC cylRad cylHoch))
)
(defun aib (w) (* pi (/ w 180.0)))
(defun Te:R-TischBack ()
  (setvar "CMDECHO" cealt)
  (setvar "MENUECHO" mealt)
  (setvar "OSMODE"  osalt)
  (setvar "ORTHOMODE" ortalt)
  (setvar "CLAYER"  layalt)
  (setvar "CECOLOR" coalt)
)
(defun C:R-Tisch ( / dcl_id cealt mealt osalt ortalt layalt coalt TDU TH TD TUE FuDo FuDu FusS FuSr FusEu 
                  AnzFu ZaH ZaD ZAb next fil1 IMG brei hoe EP elayer FuH TDu2 FuDu2 FuDo2 PlaEP ZargiEP 
                  ZargaEP CirOb CirUn ZargaD ZargiD FusS_VAL FusG_VAL AnzFu_VAL circObj doc ex ey ez PC
                  modelSpace circleObj cylObj cylist cyliObj)
  (Te:R-TischIni)
  
(setq TDU 500     ; Tischdurchmesser
      TH 550      ; Tischhöhe 
      TD 22       ; Dicke Tischplatte
      TUE 20      ; Plattenüberstand
      FuDo 45     ; Fußdicke oben
      FuDu 20     ; Fußdicke unten
      FusS 1      ; Fuß schräg
      FuSr 20     ; Fußschräge
      FusEu 10    ; Fuß Einrück Unten
      AnzFu 3     ; Anzahl Füße
      ZaH 40      ; Zargenhöhe
      ZaD 18      ; Zargendicke
      ZAb 3       ; Zargenabstand > Fuß
    ;  EP '(0.0 0.0 0.0)
)

	(Te:R-TischDlg)
	(Te:R-TischBack)
  
  	(princ)
  (terpri)(terpri)
  (princ "\n  fertig!! ")

        (princ)
  )
 
  (princ "\n  Copyright (c) 2022 Thomas Elbracht ")
  (princ "\n  Starten Sie mit dem Befehl << R-Tisch >>  ")
   (terpri)
 (princ)
 