;;;  Dateiname: K-Tisch.lsp  -  erstellt: Thomas Elbracht
;;;  6.2024  -  für AC2023               mail: te@elbracht-web.de
;;;  Aufruf mit: Spieltisch
;;;
;;;  Die Routine erstellt einen Spieltisch mit Schachspielfläche 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:SpieltischIni ()
  ; 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:SpieltischDlg ()

(setq next 4)
(setq	IMG1 "Spieltisch(logo)"
	fil1 IMG1
  ) 
(if (not dcl_id) (setq dcl_id (load_dialog "Spieltisch")))

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

	(setq brei (dimx_tile "DIA"))
    	(setq hoe (dimy_tile "DIA"))
    	(start_image "DIA")
    	(fill_image 0 0 brei hoe -2)
    	(slide_image -50 -60 600 530 "Spieltisch(spieltisch)")
	(end_image)
 
    (start_image "IMG1") 
    (slide_image 180 -40 180 130 fil1)
    (end_image)
    (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 "DTUE" (rtos TUE 2 0))
    (set_tile "DFuB" (rtos FuB 2 0))
    (set_tile "DFuD" (rtos FuD 2 0))
    (set_tile "DFuR" (rtos FuR 2 0))
    (set_tile "DZaH" (rtos ZaH 2 0))
    (set_tile "DZaD" (rtos ZaD 2 0))
    (set_tile "DZAb" (rtos ZAb 2 0))
    (set_tile "DEchec" (rtos Echec 2 0))
    (set_tile "DEchecD" (rtos EchecD 2 0))
(if (= Pladre 0) (progn(set_tile "DPladre0" "1")(set_tile "DPladre1" "0")))
(if (= Pladre 1) (progn(set_tile "DPladre0" "0")(set_tile "DPladre1" "1")))

    (action_tile "DTL" "(DO_TL $value)")
    (action_tile "DTB" "(DO_TB $value)")
    (action_tile "DTH" "(setq TH (atof $value))")
    (action_tile "DTD" "(setq TD (atof $value))")
    (action_tile "DTUE" "(setq TUE (atof $value))")
    (action_tile "DFuB" "(setq FuB (atof $value))")
    (action_tile "DFuD" "(setq FuD (atof $value))")
    (action_tile "DFuR" "(setq FuR (atof $value))")
    (action_tile "DZaH" "(setq ZaH (atof $value))")
    (action_tile "DZaD" "(setq ZaD (atof $value))")
    (action_tile "DZAb" "(setq ZAb (atof $value))")
    (action_tile "DEchec" "(setq Echec (atof $value))")
    (action_tile "DEchecD" "(setq EchecD (atof $value))")
    (action_tile "DPladre0" "(DO_Pladre0 $value)")
    (action_tile "DPladre1" "(DO_Pladre1 $value)") 
    (action_tile "accept" "(done_dialog 1)")
    (action_tile "cancel" "(done_dialog 0)")
(setq next (start_dialog))

    (if (= next 1) 
  (Te:SpieltischZeich)
  (Te:SpieltischBack)
  )
    )
  (unload_dialog dcl_id)
)
(defun Te:SpieltischZeich ()
  (vl-load-com)
  (vl-cmdf "_.view" "S" "TE_VIEW")
  (vl-cmdf "_.UCS" "")
  (vl-cmdf "_.PLAN" "W")
  (vl-cmdf "_.LAYER" "_M" "Te_Spieltisch" "_CO" "33" "" "")
 
(setq FuH (- TH (* TD 2.0))
      FuEPu1 (list (+(car EP) TUE) (+ (cadr EP) TUE)(caddr EP))
      FuEPm1 (list (+(car EP) TUE) (+ (cadr EP) TUE)(+(caddr EP)(- FuH ZaH)))
      FuEPo1 (list (+(car EP) TUE) (+ (cadr EP) TUE)(+(caddr EP)FuH)))

 (setq FuEPu2 (list (+ (car FuEPu1) (- FuB FuR)) (+(cadr FuEPu1)(- FuD FuR)) (caddr FuEPu1))
       FuEPm2 (list (+ (car FuEPm1) FuB) (+(cadr FuEPm1)FuD) (caddr FuEPm1))
       FuEPo2 (list (+ (car FuEPo1) FuB) (+(cadr FuEPo1) FuD) (caddr FuEPo1)))

(setq MP1 (list (+ (car EP) (/ TL 2.0)) (cadr EP) (caddr EP))
	MP2 (list (+ (car EP)(/ TL 2.0)) (+(cadr EP) TB) (caddr EP))
	MP3 (list (car EP) (+(cadr EP)(/ TB 2.0)) (caddr EP))
	MP4 (list (+ (car EP) TL) (+(cadr EP) (/ TB 2.0)) (caddr EP)))
  
  (vl-cmdf "_rectangle" FuEPu1 FuEPu2)(setq contur_U (entlast))
  (vl-cmdf "_rectangle" FuEPm1 FuEPm2)(setq contur_M (entlast))
  (vl-cmdf "_rectangle" FuEPo1 FuEPo2)(setq contur_O (entlast))

  (setq pieds (ssadd))
  (vl-cmdf "_loft" contur_U contur_M contur_O "" "")(setq fuss_ul (entlast))(ssadd (entlast) pieds) 
  (vl-cmdf "_mirror"  fuss_ul "" MP1 MP2 "")(ssadd (entlast) pieds) (setq fuss_ur (entlast))
  (vl-cmdf "_mirror" fuss_ul "" MP3 MP4 "")(ssadd (entlast) pieds)
  (vl-cmdf "_mirror" fuss_ur  "" MP3 MP4 "")(ssadd (entlast) pieds)
  
  (setq ssEchec (ssadd))
(setq EPe (list (+ (car EP) (-(/ TL 2.0) (* Echec 4.0))) (-(/ TB 2.0) (* Echec 4.0)) (+(caddr EP)(- TH EchecD))))
  (Te:Quad EPe Echec Echec EchecD)(ssadd (entlast) ssEchec)
  (vlax-put-property QuadObj 'Color 35)
  (Te:Quad (list (+(car EPe) Echec)(cadr EPe)(caddr EPe)) Echec Echec EchecD)(ssadd (entlast) ssEchec)
  (vlax-put-property QuadObj 'Color 51)
  (Te:Quad (list (car EPe)(+(cadr EPe) Echec)(caddr EPe)) Echec Echec EchecD)(ssadd (entlast) ssEchec)
  (vlax-put-property QuadObj 'Color 51)
  (Te:Quad (list (+(car EPe) Echec)(+(cadr EPe) Echec)(caddr EPe)) Echec Echec EchecD)(ssadd (entlast) ssEchec)
  (vlax-put-property QuadObj 'Color 35)
(vl-cmdf "_.array" ssEchec "" "" "4" "4" (* Echec 2.0)  (* Echec 2.0))(ssadd (entlast) ssEchec)
 
(setq tousEchec (ssadd))

 (setq eles (ssget "_X" '((0 . "3DSOLID") (62 . 35))))
 (setq eles2 (ssget "_X" '((0 . "3DSOLID") (62 . 51))))

	  (setq sl (sslength eles) a 0 b 0)  
	(while (< a sl)
	(setq ob (ssname eles a)) (ssadd ob tousEchec)
        (setq a (1+ a))
	)
	  (while (< b sl)
	(setq ob (ssname eles2 b)) (ssadd ob tousEchec)
        (setq b (1+ b))
	)
	  
    (Te:Quad (list (car EP)(cadr EP)(+(caddr EP)(- TH (* TD 2.0)))) TL TB TD)(setq platGu (entlast))

  (Te:Quad (list (car EP)(cadr EP)(+(caddr EP)(- TH TD))) TL TB TD)(setq platGo (entlast))
	  (Te:Quad EPe (* Echec 8.0) (* Echec 8.0) EchecD)(setq platK (entlast))
	  (vl-cmdf "_subtract" platGo "" platK "")
 
(Te:Quad (list (+(car EP) ZAb TUE) (+ (cadr EP) FuD TUE)(+(caddr EP) (- TH (* TD 2.0) ZaH))) ZaD (- TB (* 2 (+ TUE FuD))) ZaH)
    (setq TravLi (entlast))
    (ssadd TravLi pieds)
	  
(vl-cmdf "_mirror" TravLi "" MP1 MP2 "")(setq TravRe (entlast))
    (ssadd TravRe pieds)
 
(Te:Quad (list (+(car EP) FuB TUE) (+ (cadr EP) ZAb TUE)(+(caddr EP) (- TH (* TD 2.0) ZaH))) (- TL (* 2 (+ TUE FuB))) ZaD  ZaH)
    (setq TravUn (entlast))(ssadd TravUn pieds)
  (vl-cmdf "_mirror" TravUn "" MP3 MP4 "")(setq TravOb (entlast))
    (ssadd TravOb pieds)

(setq TravMi (list (car MP2)(cadr MP2)(+(caddr EP) (- TH TD)))
      DreP0 (polar TravMi (aib 225) TB)
      TravMi2 (list (+ (car EP)(/ TL 2.0)) (+(cadr EP) (/ TB 2.0)) (caddr TravMi))
      DreP1 (polar TravMi2 (aib 135) TB))
      
(setq DrePu (inters TravMi DreP0 TravMi2 DreP1))
(Te:Quad (list (-(car DrePu) 40.0) (+ (cadr EP) ZaD TUE ZAb)(+(caddr EP) (- TH (* TD 2.0) ZaD))) 80.0 (- TB (* 2 (+ TUE ZaD ZAb)))  ZaD)

  (setq TravMii (entlast))(ssadd TravMii pieds)
  (terpri)(terpri)
  
(if (= Pladre 1) (progn
		  (arxload "geom3d")
   (vl-cmdf "_rotate" platGu platGo tousEchec "" DrePu 270)
	   (rotate3d platgo TravMi2 TravMi 180)
	  (rotate3d tousEchec TravMi2 TravMi 180)
		  ))
   (vl-cmdf "_.view" "H" "TE_VIEW")
  (ssadd platGu tousEchec)(ssadd platGo tousEchec) 
  (terpri)
  (princ)
  (princ "\n Einfügepunkt für den Tisch: ")
(command-s "_move" pieds tousEchec "" EP PAUSE)
   (terpri)(princ)
   (vl-cmdf "_.zoom" "G" "_.zoom" "0.8x")
  (vl-cmdf "_.view" "Lö" "TE_VIEW")
)
(defun DO_TL (in)
(setq TL_VAL (atof in))
  (setq TL TL_VAL TB (/ TL 1.6))
  (set_tile "DTB" (rtos TB 2 0))
)
(defun DO_TB (in)
(setq TB_VAL (atof in))
  (setq TB TB_VAL TL (* TB 1.6))
  (set_tile "DTL" (rtos TL 2 0))
)
(defun DO_Pladre0 (in)
(setq Pladre_VAL (atof in))
(if (= Pladre_VAL 1)  (progn (setq Pladre 0)
		     (set_tile "DPladre0" "1")(set_tile "DPladre1" "0")))
) 
(defun DO_Pladre1 (in)
(setq Pladre_VAL (atof in))
(if (= Pladre_VAL 1)  (progn (setq Pladre 1)
		     (set_tile "DPladre0" "0")(set_tile "DPladre1" "1")))
)
(defun Te:Quad (CP laenge breite hoehe)
    (setq SpieltischObj (vlax-get-acad-object))
    (setq Holzliste (vla-get-ActiveDocument  SpieltischObj))
    (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:SpieltischBack ()
  (setvar "CMDECHO" cealt)
  (setvar "MENUECHO" mealt)
  (setvar "OSMODE"  osalt)
  (setvar "CLAYER"  layalt)
  (setvar "CECOLOR" coalt)
  (setvar "ORTHOMODE" ortalt)
  (setvar "DELOBJ" delalt)
 
)
(defun C:Spieltisch ( / dcl_id cealt mealt osalt ortalt layalt coalt delalt TB TL TH TD TUE FuD FuB FuR 
		  ZaH ZaD ZAb Pladre Echec EchecD EP next fil1 IMG1 brei hoe FuH FuEPu1 FuEPm1  FuEPo1
		  FuEPu2 FuEPm2 FuEPo2 MP1 MP2 MP3 MP4 contur_U contur_M contur_O pieds fuss_ul fuss_ur
		  ssEchec tousEchec eles eles2 sl a b ob platGu platGo platK TravLi TravRe TravUn TravOb
		  TravMi DreP0 TravMi2  DreP1 DrePu TravMii TL_VAL TB_VAL Pladre_VAL SpieltischObj
		  Holzliste px py pz MP modelSpace QuadObj)
  
  (Te:SpieltischIni)
  
(setq TB 625      ; Spieltischbreite
      TL 1000     ; Spieltischlänge
      TH 770      ; Spieltischhöhe
      TD 20       ; Dicke Spieltischplatte
      TUE 30      ; Plattenüberstand
      FuD 40      ; Fußdicke
      FuB 40      ; Fußbreite
      FuR 10      ; Fußreduzuierung
      ZaH 80      ; Zargenhöhe
      ZaD 16      ; Zargendicke
      ZAb 5       ; Zargenabstand > Fuß
      Pladre 0    ; Tischplatten drehen offen =1
      Echec 30    ; Figurenfeld
      EchecD 1    ; Figurenfeld Dicke
)
  (setq EP '(0.0 0.0 0.0))

	(Te:SpieltischDlg)
	(Te:SpieltischBack)
  	(princ)
  )
  (princ "\n  Copyright (c) 2024 Thomas Elbracht ")
  (princ "\n  Starten Sie mit dem Befehl << Spieltisch >>  ")
   (terpri)(princ)