;;;  Dateiname: D-Tisch.lsp  -  erstellt: Thomas Elbracht
;;;  4.2023  -  für AC2023               mail: te@elbracht-web.de
;;;  Aufruf mit: D-Tisch
;;;
;;;  Die Routine erstellt einen Designertisch für den Einrichtungsplaner
;;
  (defun Te:D-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")
	delalt (getvar "DELOBJ")
	)
  
  	(setvar "CMDECHO" 0)
	(setvar "MENUECHO" 0)
  	(setvar "OSMODE" 0)
        (setvar "ORTHOMODE" 0)
        (setvar "DELOBJ" 2)
    
  (defun *error* (sTxt)	
    (princ (strcat "\n" sTxt))

  (setvar "CMDECHO" cealt)
  (setvar "MENUECHO" mealt)
  (setvar "OSMODE" osalt) 
    
    (if	*te:error*
      (setq *error* *te:error*)	
      (setq *error* nil)
    )
    (princ)
  )
nil
)
(defun Te:D-TischDlg ()

(setq next 4)
(setq	IMG1 "D-Tisch(logo)"
	fil1 IMG1
  ) 
(if (not dcl_id) (setq dcl_id (load_dialog "D-Tisch")))

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

	(setq brei (dimx_tile "DIA"))
    	(setq hoe (dimy_tile "DIA"))
    	(start_image "DIA")
    	(fill_image 0 0 brei hoe -2)
    	(slide_image 0 -10 550 400 "D-Tisch(D-Tisch)")
	(end_image)
 
    (start_image "IMG1") 
    (slide_image 180 -40 180 130 fil1)
    (end_image)
    (Te:PlAbr PlAbr)
    (set_tile "DTL" (rtos TL 2 0))
    (set_tile "DTB" (rtos TB 2 0))
    (set_tile "DTH" (rtos TH 2 0))
    (set_tile "DTD" (rtos TD 2 0))
    (set_tile "DPlAbr" PlAbr)
    (set_tile "DPlRa" (rtos PlRa 2 0))
    (set_tile "DFaBr" (rtos FaBr 2 0))
    (set_tile "DFaH" (rtos FaH 2 0))
    (set_tile "DZaH" (rtos ZaH 2 0))
    (set_tile "DZaD" (rtos ZaD 2 0))
    (action_tile "DTL" "(setq TL (atof $value))")
    (action_tile "DTB" "(setq TB (atof $value))")
    (action_tile "DTH" "(setq TH (atof $value))")
    (action_tile "DTD" "(setq TD (atof $value))")
    (action_tile "DPlAbr" "(Te:PlAbr $value)")    
    (action_tile "DPlRa" "(setq PlRa (atof $value))")
    (action_tile "DFaBr" "(setq FaBr (atof $value))")
    (action_tile "DFaH" "(setq FaH (atof $value))")
    (action_tile "DZaH" "(setq ZaH (atof $value))")
    (action_tile "DZaD" "(setq ZaD (atof $value))")
    (action_tile "FUSSfrag" "(done_dialog 5)")
    (action_tile "accept" "(done_dialog 1)")
    (action_tile "cancel" "(done_dialog 0)")
(setq next (start_dialog))
    (if	(= next 5)(DO_FUSS) )
    (if (= next 1) 
  (Te:D-TischZeich)
  (Te:D-TischBack)
  )
    )
  (unload_dialog dcl_id)
)
(defun Te:D-TischZeich ()
  (vl-load-com)
  (vl-cmdf "_.view" "S" "TE_VIEW")
  (vl-cmdf "_.UCS" "W")
  (vl-cmdf "_.PLAN" "W")
  (setvar "CMDECHO" 0)
  (command-s "LAYER" "_M" "Te_D-Tisch" "_CO" "42" "Te_D-Tisch" "")

  (setvar "osmode" 0)(setvar "DELOBJ" 2)
    (setq Wi (aib 180) Wio (aib 90.0) Wiu (aib 270.0) Wir 0.0)
 
  (setq EP (getpoint "\n Einfügepunkt angeben, vorne links"))
  (setq PlEp (list (car EP)(cadr EP)(+(caddr EP) (- TH TD)))
	Pl2 (polar PlEp Wir TL)
	Pl3 (polar Pl2 Wio TB)
	Pl4 (polar Pl3 Wi TL)
	FaEp (list (car EP)(+(cadr EP)(/ TB 2.0))(caddr PlEp))
	Fa1 (polar FaEp Wir FaBr)
	Fa2 (list (car FaEp)(cadr FaEp)(+(caddr FaEp) FaH))
	Fa3 (list (car FaEp)(cadr FaEp)(caddr Fa2))
	Fa4 (list (car FaEp)(cadr FaEp)(+(caddr Fa2) FaH))
	)

  (vl-cmdf "_3DPOLY" FaEp Fa1 Fa2 FaEp "") (setq FasCon (entlast))
  
(vl-cmdf "_.PLINE" PlEp Pl2 Pl3 Pl4 "s")
(setq Fas (entlast))

  (if (= PlAbr "1")(progn
  (vl-cmdf "_.fillet" "R" PlRa)(vl-cmdf "_.fillet" "P" Fas)
  (setq Fas (entlast))
  (vl-cmdf "_SWEEP" FasCon "" Fas) (setq Fass (entlast))
  (vl-cmdf "_.PLINE" PlEp Pl2 Pl3 Pl4 "s")(setq Plaat (entlast))
  (vl-cmdf "_.fillet" "R" PlRa)(vl-cmdf "_.fillet" "P" Plaat)
  (vl-cmdf "_EXTRUDE" Plaat "" TD)(setq Plat (entlast))
  (vl-cmdf "_SUBTRACT" Plat "" Fass "")
  )
    (progn
    (Te:Quad PlEp TL TB TD) (setq Plat (entlast))
    (vl-cmdf "_SWEEP" FasCon "" Fas) (setq Fass (entlast))
    (vl-cmdf "_SUBTRACT" Plat "" Fass "")
   ))
 (vl-cmdf "CECOLOR" 33)
  
(setq FuEpOb (list (+(car EP)FaBr)(+(cadr EP)FaBr)(+(caddr EP) (- TH TD)))
      FuOb1 (list (car FuEpOb)(-(cadr FuEpOb)(/ FuDk 2.0))(caddr FuEpOb))
      FuOb2 (list (+(car FuEpOb)FuBob)(-(cadr FuEpOb)(/ FuDg 2.0))(caddr FuEpOb))
      FuOb3 (list (+(car FuEpOb)FuBob)(+(cadr FuEpOb)(/ FuDg 2.0))(caddr FuEpOb))
      FuOb4 (list (car FuEpOb)(+(cadr FuEpOb)(/ FuDk 2.0))(caddr FuEpOb))
      FuOb5 (polar FuEpOb (aib -45.0) 50.0)
      FuOb6 (inters FuOb1  FuOb2 FuEpOb FuOb5)
      FuOb7 (polar FuOb6 Wio 50.0)
      FuOb8 (polar FuEpOb Wir FuBun)
      FuOb9 (inters FuOb6  FuOb7 FuEpOb FuOb8)
      FuObShieb (distance FuEpOb FuOb9)
      FuObShiebEp (polar FuEpOb (aib 45.0) FuObShieb)
      FuOb10 (polar FuOb8 Wio 50.0)
      FuOb11 (polar FuOb8 Wiu 50.0)
      FuOb12 (inters FuOb1  FuOb2 FuOb10 FuOb11)
      FuOb13 (inters FuOb3  FuOb4 FuOb10 FuOb11)
       )
    (setq PlaMi1 (polar Ep Wir (/ TL 2.0))
	PlaMi2 (polar PlaMi1 Wio (/ TB 2.0))
	PlaMi3 (polar PlaMi2 Wir (/ TL 2.0))
	)

    (vl-cmdf "_.PLINE" FuOb1 FuOb2 FuOb3 FuOb4 "s")
    (setq FuObCon (entlast))
    (vl-cmdf "_.POINT" FuOb1)(setq PuOb1 (entlast))
    (vl-cmdf "_.POINT" FuOb2)(setq PuOb2 (entlast))
    (vl-cmdf "_.POINT" FuOb3)(setq PuOb3 (entlast))
    (vl-cmdf "_.POINT" FuOb4)(setq PuOb4 (entlast))
    (vl-cmdf "_ROTATE" FuObCon PuOb1 PuOb2 PuOb3 PuOb4 "" FuEpOb 45)
    (vl-cmdf "_MOVE" FuObCon PuOb1 PuOb2 PuOb3 PuOb4 "" FuEpOb FuObShiebEp)

(setq PuObN1 (dxf 10 (entget PuOb1))
      PuObN2 (dxf 10 (entget PuOb2))
      PuObN3 (dxf 10 (entget PuOb3))
      PuObN4 (dxf 10 (entget PuOb4)))

  (vl-cmdf "_mirror" PuOb1 "" PlaMi1 PlaMi2 "")
  (setq PuOb1neu (entlast))
  (setq PuOb1neuEp (dxf 10 (entget PuOb1neu)))
  (vl-cmdf "_mirror" PuOb2 "" PlaMi1 PlaMi2 "")
  (setq PuOb2neu (entlast))
  (setq PuOb2neuEp (dxf 10 (entget PuOb2neu)))

  (vl-cmdf "_mirror" PuOb3 "" PlaMi2 PlaMi3 "")
  (setq PuOb3neu (entlast))
  (setq PuOb3neuEp (dxf 10 (entget PuOb3neu)))

  (vl-cmdf "_mirror" PuOb4 "" PlaMi2 PlaMi3 "")
  (setq PuOb4neu (entlast))
  (setq PuOb4neuEp (dxf 10 (entget PuOb4neu)))
  
  (setq PlmLi (list (car PuObN2)(-(cadr PuObN2) ZaD)(caddr PuObN2))
	PlmRe (list (car PuOb2neuEp)(-(cadr PuOb2neuEp)ZaD)(caddr PuOb2neuEp)))
  (setq PliMLi (inters PuObN1 PuObN2 PlmLi PlmRe nil)
       PliMRe (inters PuOb1neuEp PuOb2neuEp PlmLi PlmRe nil))
  (setq PuObN2 (polar PuObN2 Wi 5.0)
	PliMLi (polar PliMLi Wi 5.0)
	PliMRe (polar PliMRe Wir 5.0)
	PuOb2neuEp (polar PuOb2neuEp Wir 5.0)
	PliMLiU1 (list (car PliMLi)(cadr PliMLi)(-(caddr PliMLi)ZaH))
	)

  (vl-cmdf "_.PLINE" PliMLi PliMRe PuOb2neuEp PuObN2 "s")
  (setq TravLCon (entlast))
  (vl-cmdf "_MOVE" TravLCon "" PliMLi PliMLiU1)
  (vl-cmdf "_EXTRUDE" TravLCon "" ZaH)(setq TravLCon (entlast))
  (vl-cmdf "_mirror" TravLCon "" PlaMi2 PlaMi3 "")

 (setq PlmLiU (list (-(car PuObN3) ZaD)(cadr PuObN3)(caddr PuObN3))
       PlmLiO (list (-(car PuOb3neuEp)ZaD)(cadr PuOb3neuEp)(caddr PuOb3neuEp)))
 (setq PliMLiU (inters PuObN3 PuObN4 PlmLiU PlmLiO nil)
      PliMLiO (inters PuOb3neuEp PuOb4neuEp PlmLiU PlmLiO nil))

  (setq PuObN3 (polar PuObN3 Wiu 5.0)
	PliMLiU (polar PliMLiU Wiu 5.0)
	PliMLiO (polar PliMLiO Wio 5.0)
	PuOb3neuEp (polar PuOb3neuEp Wio 5.0)
	PliMLiU2 (list (car PliMLiU)(cadr PliMLiU)(-(caddr PliMLiU)ZaH))
	)
  (vl-cmdf "_.PLINE" PliMLiU PliMLiO PuOb3neuEp PuObN3 "s")
  (setq TravKCon (entlast))
  (vl-cmdf "_MOVE" TravKCon "" PliMLiU PliMLiU2)
  (vl-cmdf "_EXTRUDE" TravKCon "" ZaH)(setq TravKCon (entlast))
  (vl-cmdf "_mirror" TravKCon "" PlaMi1 PlaMi2 "") 
  
  (vl-cmdf "_.ERASE" PuOb1 PuOb2 PuOb3 PuOb4 PuOb1neu PuOb2neu PuOb3neu PuOb4neu "")

  (vl-cmdf "_.PLINE" FuOb1 FuOb12 FuOb13 FuOb4 "s")
  (setq FuUnCon (entlast))
  (setq FuEpUn (polar Ep (aib 45.0) FuPlAbst))
  (vl-cmdf "_MOVE" FuUnCon "" FuEpOb FuEpUn)
  (vl-cmdf "_ROTATE" FuUnCon "" FuEpUn 45)
  (vl-cmdf "_loft" FuUnCon FuObCon "" "")
  (setq FuLoft (entlast))
  (vl-cmdf "_mirror" FuLoft "" PlaMi1 PlaMi2 "") 
  (setq FuLoft2 (entlast))
  (vl-cmdf "_mirror" FuLoft FuLoft2 "" PlaMi2 PlaMi3 "") 

  (vl-cmdf "_.view" "H" "TE_VIEW")
  (vl-cmdf "_.zoom" "G" "_.zoom" "0.8x")
  (vl-cmdf "_.view" "Lö" "TE_VIEW")
)
(defun DO_FUSS ()
  (new_dialog "DTisch2" dcl_id)
  	(setq brei2 (dimx_tile "DIA"))
    	(setq hoe2 (dimy_tile "DIA"))
    	(start_image "DIA")
    	(fill_image 0 0 brei2 hoe2 -2)
    	(slide_image -30 -120 420 440 "D-Tisch(D-Tisch2)")
	(end_image)
  
    (set_tile "DFuBob" (rtos FuBob 2 0))
    (set_tile "DFuBun" (rtos FuBun 2 0))
    (set_tile "DFuDg" (rtos FuDg 2 0))
    (set_tile "DFuDk" (rtos FuDk 2 0))
    (set_tile "DFuPlAbst" (rtos FuPlAbst 2 0))
    (action_tile "DFuBob" "(setq FuBob (atof $value))")
    (action_tile "DFuBun" "(setq FuBun (atof $value))")
    (action_tile "DFuDg" "(setq FuDg (atof $value))")
    (action_tile "DFuDk" "(setq FuDk (atof $value))")
    (action_tile "DFuPlAbst" "(setq FuPlAbst (atof $value))")
  
  (start_dialog)
)
(DEFUN dxf (c el) (cdr (assoc c el)))
(DEFUN aib (w) (* pi (/ w 180.0)))
(defun Te:PlAbr (in)(setq PlAbr in) (set_tile "DPlAbr" PlAbr)
(if (= PlAbr "1")
  (mode_tile "DPlRa" 0)(mode_tile "DPlRa" 1)
       )
 )
(defun Te:Quad (CP laenge breite hoehe)
    (setq D-TischObj (vlax-get-acad-object))
    (setq Holzliste (vla-get-ActiveDocument  D-TischObj))
  	(setq px (+(car CP) (/ laenge 2.0)) py (+(cadr CP) (/ breite 2.0))  pz (+ (caddr CP)(/ hoehe 2.0)))

        (setq MP (vlax-3d-point px py pz))
    
    (setq modelSpace (vla-get-ModelSpace Holzliste))
    (setq QuadObj (vla-AddBox modelSpace MP laenge breite hoehe))
   )
(defun Te:D-TischBack ()
  (setvar "CMDECHO" cealt)
  (setvar "MENUECHO" mealt)
  (setvar "OSMODE"  osalt)
  (setvar "CLAYER"  layalt)
  (setvar "CECOLOR" coalt)
  (setvar "ORTHOMODE" ortalt)
  (setvar "DELOBJ" delalt)
)
(defun C:D-Tisch ( / dcl_id cealt mealt osalt ortalt layalt coalt delalt TB TL TH TD PlAbr PlRa FaBr FaH
		  FuBob FuBun FuDg FuDk FuPlAbst ZaH ZaD EP fil1 IMG1 next brei hoe Wi Wio Wiu Wir PlEp
		  Pl2 Pl3 Pl4 FaEp Fa1 Fa2 Fa3 Fa4 FasCon Fas Fass Plaat Plat FuEpOb FuOb1 FuOb2 FuOb3
		  FuOb4 FuOb5 FuOb6 FuOb7 FuOb8 FuOb9 FuObShieb FuObShiebEp FuOb10 FuOb11 FuOb12 FuOb13
		  PlaMi1 PlaMi2 PlaMi3 FuObCon PuOb1 PuOb2 PuOb3 PuOb4 PuObN1 PuObN2 PuObN3 PuObN4 PuOb1neu
		  PuOb1neuEp PuOb2neu PuOb2neuEp PuOb3neu PuOb3neuEp PuOb4neu PuOb4neuEp PlmLi PlmRe PliMLi
		  PliMRe PuObN2 PliMLi PliMRe PuOb2neuEp PliMLiU1 TravLCon PlmLiU PlmLiO PliMLiU PliMLiO
		  PuObN3 PliMLiU PliMLiO PuOb3neuEp PliMLiU2 TravKCon FuUnCon FuEpUn FuLoft FuLoft2 D-TischObj
		  Holzliste px py pz MP modelSpace QuadObj)		  

  (Te:D-TischIni)
  
(setq TB 800      ; D-Tischbreite
      TL 1600     ; D-Tischlänge
      TH 770      ; D-Tischhöhe
      TD 30       ; Dicke D-Tischplatte
      PlAbr "1"   ; Plattenabrundung
      PlRa 10     ; Radius Plattenabrundung
      FaBr 60     ; Fasenbreite
      FaH 20      ; Fasenhöhe
      FuBob 70    ; Fußbreite oben
      FuBun 40    ; Fußbreite unten
      FuDg 30     ; Fußdicke groß
      FuDk 10     ; Fußdicke klein
      FuPlAbst 20 ; Fuß-Platte Überstand unten      
      ZaH 80      ; Zargenhöhe
      ZaD 20      ; Zargendicke
)

  (setq EP '(0.0 0.0 0.0))
	(Te:D-TischDlg)
	(Te:D-TischBack)
  	(princ)
   )
  (princ "\n  Copyright (c) 2023 Thomas Elbracht ")
  (princ "\n  Starten Sie mit dem Befehl << D-Tisch >>  ")
  
  (princ)
