;;;  Dateiname: Tisch-rf.lsp  -  erstellt: Thomas Elbracht
;;;  10.2023  -  für AC2023               mail: te@elbracht-web.de
;;;  Aufruf mit: Tisch-rf
;;;
;;;  Die Routine erstellt einen Tisch mit runden Füßen für den Einrichtungsplaner
;;
  (defun Te:Tisch-rfIni ()
  ; 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")
	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:Tisch-rfDlg ()

(setq next 6)
(setq	IMG1 "Tisch-rf(logo)"
	fil1 IMG1
  ) 
(if (not dcl_id) (setq dcl_id (load_dialog "Tisch-rf")))

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

	(setq brei (dimx_tile "DIA"))
    	(setq hoe (dimy_tile "DIA"))
    	(start_image "DIA")
    	(fill_image 0 0 brei hoe -2)
    	(slide_image -30 -325 520 720 "Tisch-rf(Tisch-rf)")
	(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 "DPD" (rtos PD 2 0))
    (set_tile "DTUE" (rtos TUE 2 0))
    (set_tile "DFuDo" (rtos FuDo 2 0))
    (set_tile "DFuDu" (rtos FuDu 2 0))
    (if (= MatFe 1) (progn
    (set_tile "DMatFe" "1")(mode_tile "DMatHo" 0)))
    (set_tile "DZaH" (rtos ZaH 2 0))
    (set_tile "DZaD" (rtos ZaD 2 0))
    (set_tile "DFaF" (rtos FaF 2 0))
    (set_tile "DFaP" (rtos FaP 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 "DPD" "(setq PD (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 "DMatHo" "(DO_MatHo $value)")
    (action_tile "DMatFe" "(DO_MatFe $value)")
    (action_tile "DZaH" "(setq ZaH (atof $value))")
    (action_tile "DZaD" "(setq ZaD (atof $value))")
    (action_tile "FarbfragF" "(done_dialog 2)")
    (action_tile "FarbfragP" "(done_dialog 3)")
    (action_tile "accept" "(done_dialog 1)")
    (action_tile "cancel" "(done_dialog 0)")
    (setq next (start_dialog))

  (if (= next 2) (setq FaF (acad_colordlg FaF nil)))    
  (if (= next 3) (setq FaP (acad_colordlg FaP nil)))

(if (= next 1)
  (Te:Tisch-rfZeich)
  (Te:Tisch-rfBack)
  )
    )
  (unload_dialog dcl_id)
)
(defun Te:Tisch-rfZeich ()
  (vl-load-com)
  (vl-cmdf "_.view" "S" "TE_VIEW")
  (vl-cmdf "_.UCS" "")
  (vl-cmdf "_.PLAN" "W")
  (setq EP (getpoint "\n Einfügepunkt angeben, vorne links "))
  (setq Wi (aib 0.0) Wio (aib 90) Wil (aib 180.0) Wiu (aib 270.0))
  
(setq acadObj (vlax-get-acad-object))
(setq doc (vla-get-ActiveDocument acadObj))
(setq color (rtos FaF))
(setq layers (vla-get-Layers doc))
(setq layerObj (vla-Add layers "Te_Tisch-rf"))
(vla-put-Color layerObj color)(vla-put-ActiveLayer doc layerObj)

(setq FuDu2 (/ FuDu 2.0) FuDo2 (/ FuDo 2.0))
(Te:Circle (list (+(car EP) FuDu2) (+ (cadr EP) FuDu2)(caddr EP)) FuDu2)
(setq CircU (entlast))
  (Te:Circle (list (+(car EP) FuDo2) (+ (cadr EP) FuDo2)(+(caddr EP)(- TH ZaH PD))) FuDo2)
(setq CircM (entlast))
    (Te:Circle (list (+(car EP) FuDo2) (+ (cadr EP) FuDo2)(+(caddr EP) TH)) FuDo2)
(setq CircO (entlast))
 (vl-cmdf "_loft" CircU CircM CircO "" "")(setq LofFu (entlast))

  (setvar "CECOLOR" (rtos FaP))

  (setq PlaUK (list (car EP)(cadr EP)(+(caddr EP)(- TH PD))))

  (vl-cmdf "_.PLINE" PlaUK (list (+(car EP) FuDo 2.0)(cadr EP)(+(caddr EP)(- TH PD)))
	   (list (+(car EP) FuDo 2.0)(+(cadr EP) FuDo2 1.0)(+(caddr EP)(- TH PD))) "K" "RA" (+ FuDo2 1.0)
	   (list (+(car EP) FuDo2 1.0)(+(cadr EP) FuDo 2.0)(+(caddr EP)(- TH PD))) "LI"
	   (list (car EP)(+(cadr EP) FuDo 2.0)(+(caddr EP)(- TH PD))) "S")

  (setq PlAus (entlast))
  (vl-cmdf "_extrude" PlAus "" PD)
  (setq PlAus (entlast))

  (setq PuLMi (polar EP Wi (/ TL 2.0)) PuBMi (polar EP Wio (/ TB 2.0)))
  (vl-cmdf "_mirror" PlAus "" PuLMi (polar PuLMi Wio (/ TL 2.0)) "")
  (setq PlAusR (entlast))
  (vl-cmdf "_mirror" PlAus "" PuBMi (polar PuBMi Wi (/ TB 2.0)) "")
  (setq PlAusL (entlast))
  (vl-cmdf "_mirror" PlAusR "" PuBMi (polar PuBMi Wi (/ TB 2.0)) "")
  (setq PlAusRo (entlast))

  (Te:Quad (list (+(car EP)TUE)(+(cadr EP)TUE)(+(caddr EP)(- TH PD))) (- TL (* TUE 2.0)) (- TB (* TUE 2.0)) PD)
  (setq Plat (entlast))

  (vl-cmdf "DIFFERENZ" Plat "" PlAus PlAusR PlAusL PlAusRo "")

  (setq Plat (entlast))
  (vl-cmdf "_mirror" LofFu "" PuLMi (polar PuLMi Wio (/ TL 2.0)) "")
  (setq LofFuR (entlast))
  (vl-cmdf "_mirror" LofFu "" PuBMi (polar PuBMi Wi (/ TB 2.0)) "")
  (setq LofFuL (entlast))
  (vl-cmdf "_mirror" LofFuR "" PuBMi (polar PuBMi Wi (/ TB 2.0)) "")
  (setq LofFuRo (entlast))
  (setvar "CECOLOR" "BYLAYER")

(Te:Quad (list (-(+(car EP) FuDo) 5.0)(-(+(cadr EP) FuDo2)(/ ZaD 2.0)) (+(caddr EP)(- TH PD ZaH))) (- TL (-(* FuDo 2.0)10.0)) ZaD ZaH)
  (setq TravL (entlast))

(Te:Quad (list (-(+(car EP) FuDo2)(/ ZaD 2.0))(-(+(cadr EP) FuDo) 5.0) (+(caddr EP)(- TH PD ZaH))) ZaD (- TB (-(* FuDo 2.0)10.0)) ZaH)
  (setq TravB (entlast))

(vl-cmdf "_mirror" TravB "" PuLMi (polar PuLMi Wio (/ TL 2.0)) "")
  (setq TravBr (entlast))

 (vl-cmdf "_mirror" TravL "" PuBMi (polar PuBMi Wi (/ TB 2.0)) "")
  (setq TravLo (entlast))
  (vl-cmdf "_.view" "H" "TE_VIEW")
  (vl-cmdf "_.zoom" "G" "_.zoom" "0.8x")
  (vl-cmdf "_.view" "Lö" "TE_VIEW")
)
(defun DO_MatHo (in)
(setq MatHo (atoi in))
(if (= MatHo 1)  (progn (setq FaF FaFHo ZaH 70 ZaD 20)
		     (set_tile "DMatMo" "1")(mode_tile "DMatFe" 0)
		   (set_tile "DZaH" (rtos ZaH 2 0))(set_tile "DZaD" (rtos ZaD 2 0))
		      (set_tile "DFaF" (rtos FaF 2 0))(set_tile "DFaP" (rtos FaP 2 0))
		     ))
)
(defun DO_MatFe (in)
(setq MatFe (atoi in))
(if (= MatFe 1)  (progn (setq FaF FaFFe ZaH 50 ZaD 14)
		     (set_tile "DMatFe" "1")(mode_tile "DMatHo" 0)
		   (set_tile "DZaH" (rtos ZaH 2 0))(set_tile "DZaD" (rtos ZaD 2 0))
		   (set_tile "DFaF" (rtos FaF 2 0))(set_tile "DFaP" (rtos FaP 2 0))
		     ))
)
(DEFUN aib (w) (* pi (/ w 180.0)))(DEFUN bia (Wi) (* 180 (/ Wi Pi)))
(defun Te:Circle (CP RA)
   (setq CircleObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument CircleObj))
    (setq CEN (vlax-3d-point CP))  
    (setq modelSpace (vla-get-ModelSpace doc))  
    (setq CircleObj (vla-AddCircle modelSpace CEN RA))
 )
(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 Te:Quad (CP laenge breite hoehe)
    (setq Tisch-rfObj (vlax-get-acad-object))
    (setq Holzliste (vla-get-ActiveDocument  Tisch-rfObj))
    (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:Tisch-rfBack ()
  (setvar "CMDECHO" cealt)
  (setvar "MENUECHO" mealt)
  (setvar "OSMODE"  osalt)
  (setvar "CLAYER"  layalt)
  (setvar "CECOLOR" coalt)
  (setvar "ORTHOMODE" ortalt)
  (setvar "DELOBJ" 2)
)
(defun C:Tisch-rf ( / dcl_id cealt mealt osalt ortalt layalt coalt delalt TB TL TH PD TUE FuDu FuDo ZaH ZaD MatFe
		   FaFFe FaFHo FaP FaF EP fil1 IMG1 next brei hoe Wi Wio Wil Wiu acadObj doc color layers layerObj
		   FuDu2 FuDo2 CircU CircM CircO PlaUK PlAus PuLMi PuBMi PlAusR PlAusL PlAusRo Plat LofFuR LofFuL
		   LofFuRo TravL TravB TravBr TravLo MatHo CircleObj CEN cylObj cylist ex ey ez PC cyliObj Tisch-rfObj
		   Holzliste px py pz MP modelSpace QuadObj)

  (Te:Tisch-rfIni)
  
(setq TB 800      ; Tisch-rfbreite
      TL 1600     ; Tisch-rflänge
      TH 770      ; Tisch-rfhöhe
      PD 15       ; Dicke Tisch-rfplatte
      TUE 10      ; Plattenüberstand
      FuDu 40     ; Fußdurchmesser unten
      FuDo 60     ; Fußbreite
      ZaH 50      ; Zargenhöhe
      ZaD 14      ; Zargendicke
      MatFe 1     ; Fußgestell Stahl
      FaFFe 254   ; Farbe Fußgestell Stahl
      FaFHo 43    ; Farbe Fußgestell Holz
      FaP 141     ; Farbe Platte
      FaF FaFFe   ; Farbe aktuell
)

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