;;;  Dateiname: Garderob.lsp  -  erstellt: Thomas Elbracht
;;;  1.2025  -  für AC2023               mail: te@elbracht-web.de
;;;  Aufruf mit: Garderob
;;;
;;;  Die Routine erstellt eine Garderobe 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:GarderobIni ()
  ; 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:GarderobDlg ()

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

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

	(setq brei (dimx_tile "DIA"))
    	(setq hoe (dimy_tile "DIA"))
    	(start_image "DIA")
    	(fill_image 0 0 brei hoe -2)
    	(slide_image -35 -80 600 560 (strcat "garderob(garderob"Dn "))"))
	(end_image)
 
    (start_image "IMG1") 
    (slide_image 180 -40 180 130 fil1)
    (end_image)
    (set_tile "TX1" (rtos GardeBr 2 0))
    (set_tile "DTB" (rtos TB 2 0))
    (set_tile "DTt" (rtos Tt 2 0))
    (set_tile "DTH" (rtos TH 2 0))
    (set_tile "DRBD" (rtos RBD 2 0))
    (set_tile "DEliL" (rtos EliL 2 0))
    (set_tile "DEliB" (rtos EliB 2 0))
    (set_tile "DRegSeitD" (rtos RegSeitD 2 0))
    (set_tile "DSubKBr" (rtos SubKBr 2 0))
    (set_tile "DRAbst" (rtos RAbst 2 0))
    (set_tile "DTD" (rtos TD 2 0))
    (set_tile "DGarAbstBod" (rtos GarAbstBod 2 0))
(if (= Einbog 0) (progn(set_tile "DEinbog0" "1")(set_tile "DEinbog1" "0")
		  (mode_tile "DGarAbstBod" 1)))
(if (= Einbog 1) (progn(set_tile "DEinbog0" "0")(set_tile "DEinbog1" "1")
		  (mode_tile "DGarAbstBod" 0)))
    (set_tile "DMaB" (rtos MaB 2 0))
    (set_tile "DGsH" (rtos GsH 2 0))
(if (= Ablag 0) (progn(set_tile "DAblag0" "1")(set_tile "DAblag1" "0")))
(if (= Ablag 1) (progn(set_tile "DAblag0" "0")(set_tile "DAblag1" "1")))
   
    (action_tile "DTB" "(DO_TB $value)")
    (action_tile "DTt" "(DO_Tt $value)")
    (action_tile "DTH" "(setq TH (atof $value))")
    (action_tile "DRBD" "(setq RBD (atof $value))")
    (set_tile "DEliL" (rtos EliL 2 0))
    (set_tile "DEliB" (rtos EliB 2 0))
    (action_tile "DRegSeitD" "(setq RegSeitD (atof $value))")
    (action_tile "DSubKBr" "(setq SubKBr (atof $value))")
    (action_tile "DRAbst" "(setq RAbst (atof $value))")
    (action_tile "DTD" "(DO_TD $value)")
    (action_tile "DGarAbstBod" "(setq GarAbstBod (atof $value))")
    (action_tile "DEinbog0" "(DO_Einbog0 $value)")
    (action_tile "DEinbog1" "(DO_Einbog1 $value)")    
    (action_tile "DMaB" "(DO_TMaB $value)")
    (action_tile "DGsH" "(setq GsH (atof $value))")
    (action_tile "DAblag0" "(DO_Ablag0 $value)")
    (action_tile "DAblag1" "(DO_Ablag1 $value)")
    (action_tile "accept" "(done_dialog 1)")
    (action_tile "cancel" "(done_dialog 0)")
(setq next (start_dialog))

    (if (= next 1) 
  (Te:GarderobZeich)
  (Te:GarderobBack)
  )
    )
  (unload_dialog dcl_id)
)
(defun Te:GarderobZeich ()
  (vl-load-com)
  (vl-cmdf "_.view" "S" "TE_VIEW")
  (vl-cmdf "_vpoint" "d" 270.0 90.0)
  (vl-cmdf "_.UCS" "")
  (vl-cmdf "_.PLAN" "")
  (vl-cmdf "_.LAYER" "_M" "Te_Garderob" "_CO" "33" "" "")

  (setq Wi (aib 180) Wio (aib 90.0) Wiu (aib 270.0) Wir 0.0)
  (setq Garde (ssadd))
  
(setq Pt1 (list (car EP)(+ (cadr EP) EliB)(caddr EP))
      Pt2 (polar Pt1 Wir (* EliL 2.0))
      Pt3 (polar EP Wir EliL)
      Pt4 (list (+(car EP)TB)(cadr EP)(caddr EP))
      Pt5 (list (+(car EP)TB)(+(cadr EP)Tt)(caddr EP))
      Pt6 (polar EP Wio Tt)
      px 0
      py 0)

  (vl-cmdf "_ellipse" "b" Pt1 Pt2 elib 0 "g" 90)(setq elibog (entlast))
  (vl-cmdf "_pline" Pt3 Pt4 Pt5 Pt6 Pt1 "")(setq pli (entlast))
  (vl-cmdf "region" elibog pli "") (setq rbod (entlast))
  (vl-cmdf "_extrude" rbod "" RBD)(setq regbod (entlast))(ssadd (entlast) Garde)

  (setq movlist (list px py RAbst))
  (setq movlist2 (list px py (- TH RBD)))
  (setq RegSeit (- TH (* RBD 2)))
  (vl-cmdf "_move" regbod "" "0,0,0" movlist)
  
  (vl-cmdf "_copy" regbod ""  "0,0,0" movlist2)(setq regbod2 (entlast))(ssadd (entlast) Garde)
  (Te:Quad (list (car Pt1)(+(cadr Pt1)10.0)(+(caddr EP)RAbst RBD)) RegSeitD (- Tt EliB 10.0) RegSeit)(ssadd (entlast) Garde)
  (Te:Quad (list (-(car Pt4)SubKBr)(cadr Pt4)(+(caddr EP)RAbst RBD)) RegSeitD Tt RegSeit)(ssadd (entlast) Garde)
  (Te:Quad (list (-(car Pt4)RegSeitD)(cadr Pt4)(+(caddr EP)RAbst RBD)) RegSeitD Tt RegSeit)(ssadd (entlast) Garde)
  (Te:Quad (list (+(-(car Pt4)SubKBr)RegSeitD Fug)(+(cadr Pt4) Fug)(+(caddr EP)RAbst RBD Fug)) (- SubKBr (* Fug 2.0)(* RegSeitD 2.0)) RegSeitD (- RegSeit (* Fug 2.0)))(ssadd (entlast) Garde)

(if (= einbog 0)
  (progn
  (setq GPt1 (list (car EP)(+ (cadr EP) EliB)(caddr EP))
        GPt2 (polar Pt1 Wir (* EliL 2.0))
        GPt3 (polar EP Wir EliL)
        GPt4 (list (+(car EP) GsH EliL)(cadr EP)(caddr EP))
        GPt5 (list (+(car EP) GsH EliL)(+(cadr EP)Tt)(caddr EP))
        GPt6 (polar EP Wio Tt)
	nPt4 Pt4
      )
  (vl-cmdf "_ellipse" "b" GPT1 GPT2 elib 0 "g" 90)(setq elibog2 (entlast))
  (vl-cmdf "_pline" GPT3 GPT4 GPT5 GPT6 GPT1 "")(setq pli2 (entlast))  
  (vl-cmdf "region" elibog2 pli2 "") (setq Gseit (entlast))
  )
  (progn
  (setq GPt1 (list (car EP)(+ (cadr EP) EliB)(caddr EP))
        GPt2 (polar Pt1 Wir (* EliL 2.0))
        GPt3 (polar EP Wir EliL)
	GPt4 (list (-(+(car EP) GsH)GarAbstBod)(cadr EP)(caddr EP))
        GPt5 (list (-(+(car EP) GsH)GarAbstBod)(+(cadr EP)(* EliB 2.0))(caddr EP))
        GPt6 (list (-(+(car EP) GsH EliL)GarAbstBod)(+(cadr EP)EliB)(caddr EP))     
        GPt7 (list (-(+(car EP) GsH EliL)GarAbstBod)(+(cadr EP)Tt)(caddr EP))
        GPt8 (polar EP Wio Tt)
	nPt4 (list (car Pt4)(cadr Pt4)(+ (caddr Pt4)GarAbstBod EliL))
      )
  (vl-cmdf "_ellipse" "b" GPT1 GPT2 elib 0 "g" 90)(setq elibog2 (entlast))
  (vl-cmdf "_line" GPt3 GPt4 "")(setq lin (entlast))
  (vl-cmdf "_ellipse" "b" GPT4 GPT5 EliL 270 "g" 90)(setq elibog3 (entlast))
  (vl-cmdf "_pline" GPT6 GPT7 GPT8 GPT1 "")(setq pli2 (entlast))  
  (vl-cmdf "region" elibog2 lin elibog3 pli2 "") (setq Gseit (entlast))
   ))
  (vl-cmdf "_extrude" Gseit "" Td)(setq Gseite (entlast))
  (arxload "geom3d")
  (rotate3d Gseite GPt4 GPt5 90)
  (vl-cmdf "_move" Gseite "" GPt4 nPt4)(ssadd (entlast) Garde)

  (setq mPt1 (list (+(car Pt4)TD)(+(cadr EP)Tt)(caddr Pt4))
	mPt2 (polar mPt1 Wiu (- Tt 10.0))
	mPt3 (polar mPt2 Wir (- MaB EliL))
	mPt4 (list (+(car mPt2)MaB)(+(cadr mPt2)EliB)(caddr Pt4))
	mPt5 (list (car mPt4)(cadr mPt1)(caddr Pt4))
	mPt6 (polar mPt3 Wio (* EliB 2.0))
	mPt7 (list (car mPt1)(cadr mPt1)(-(+(caddr mPt1)GsH)Td))
	mPt8 (list (-(car mPt1)10.0)(cadr mPt1)(-(+(caddr mPt1)GsH)Td 30.0))
	KlPt1 (polar mPt1 Wiu 268.0)
	KlPt2 (list (+(car KlPt1)30.0)(+(cadr KlPt1)16.0)(caddr Pt4))
	KlPt3 (polar mPt1 Wiu 230.0)
	KlPt4 (polar mPt1 Wiu 290.0)
	KlPt5 (polar KlPt3 (aib 350.78) 64.2445)
	KlPt6 (polar KlPt4 (aib 9.22) 64.2445)
	KlPt7 (list (-(car mPt5)RegSeitD)(-(cadr mPt1)230.0)(-(+(caddr mPt1)GsH)Td))
	GardeBr (+ TB Td MaB)
	GardeBr2 (/ GardeBr 2.0)
	MirPt1 (list (+(car EP)GardeBr2)(cadr EP)(caddr EP))
	MirPt2 (polar MirPt1 Wio Tt)
	)
  (vl-cmdf "_pline" KlPt3 KlPt4 KlPt6 "")(setq linHal1 (entlast))
  (vl-cmdf "_line" KlPt3 KlPt5 "")(setq linHal2 (entlast))
  (vl-cmdf "_arc" KlPt6 "e" KlPt5 "r" 20)(setq linHal3 (entlast))
  (vl-cmdf "region" linHal1 linHal2 linHal3 "")(setq linHal (entlast))
  (vl-cmdf "_extrude" linHal "" RegSeitD)(setq linHal (entlast))
  (vl-cmdf "_ellipse" "b" mPt3 mPt6 EliL 270 "g" 90)(setq elibog4 (entlast))
  (vl-cmdf "_pline" mPt4 mPt5 mPt1 mPt2 mPt3 "")(setq pli3 (entlast))
  (vl-cmdf "region" elibog4 pli3 "")(setq MBod (entlast))
  (vl-cmdf "_extrude" MBod "" Td)(setq MBod (entlast))
  (vl-cmdf "_move" MBod "" mPt1 mPt7)(ssadd (entlast) Garde)
  (vl-cmdf "_rectangle" KlPt1 KlPt2)(setq Kl_Stan (entlast))
  (vl-cmdf "_.fillet" "p" "r" 8 Kl_Stan)(setq Kl_Stan (entlast))
  (vl-cmdf "_extrude" Kl_Stan "" MaB)(setq Kl_Stan (entlast))
  (rotate3d Kl_Stan KlPt1 mPt1 90)
  (vlax-put-property (vlax-ename->vla-object Kl_Stan) 'Color 153)
  (vl-cmdf "_move" Kl_Stan "" mPt1 mPt8)(ssadd (entlast) Garde)
  (rotate3d linHal KlPt1 mPt1 90)
  (vl-cmdf "_move" linHal "" KlPt3 KlPt7)(ssadd linHal Garde)

(setq KlB1 (polar EP Wiu 740)
      KlB2 (polar KlB1 (aib 73.5138) 740)
      KlB3 (polar KlB1 (aib 106.4862) 740)
      KlB4 (polar EP Wio 14)
      KlB5 (list (+(car KlB4)2.9474)(+(cadr KlB4)11.0)(caddr EP))
      KlB6 (list (+(car KlB4)11.0)(+(cadr KlB4)19.0526)(caddr EP))
      KlB7 (list (+(car KlB6)1.9723)(+(cadr KlB6)36.821)(caddr EP))
      KlB8 (list (-(car KlB6)32.4979)(+(cadr KlB6)23.7259)(caddr EP))
      KlB9 (list (-(car KlB8)0.339)(-(cadr KlB8)0.7545)(caddr EP))
      KlB10 (list (-(car KlB8)0.9544)(-(cadr KlB8)1.3072)(caddr EP))
      KlB11 (list (-(car KlB10)1.8116)(-(cadr KlB10)1.0459)(caddr EP))
      KlB12 (list (+(car EP)0.0002)(+(cadr EP)72.3051)(caddr EP))
      KlB13 (polar KlB12 Wir 100)
      KlB14 (list (+(car KlPt1)30.0)(+(cadr KlPt1)8)(-(caddr KlPt7)30.0))
      )
 
  (vl-cmdf "_arc" KlB2 EP KlB3)(setq bueg1 (entlast))
  (vl-cmdf "_circle" EP 10)(setq bueg2 (entlast))
  (rotate3d bueg2 EP KlB1 90)
  (vl-cmdf "_rotate" bueg2 "" KlB1 "b" Klb1 EP Klb3)
  (vl-cmdf "_extrude" bueg2 "" "p" bueg1)(setq bueg1 (entlast))
  (vlax-put-property (vlax-ename->vla-object bueg1 ) 'Color 153)

  (vl-cmdf "_circle" EP 1.8)(setq bueg3 (entlast))
  (rotate3d bueg3 EP (polar EP Wir 40) 90)
  (vl-cmdf "_pline" EP KlB4 "k" KlB5 KlB6 KlB7 KlB8 KlB9 KlB10 "l" KlB11 "")(setq bueg2 (entlast))
  (vl-cmdf "_extrude" bueg3 "" "p" bueg2) (setq bueg2 (entlast))
  (vlax-put-property (vlax-ename->vla-object bueg2 ) 'Color 153)
  (vl-cmdf "_union" bueg1 bueg2 "")(setq bueg (entlast))
  (rotate3d bueg KlB12 KlB13 90)
  (vl-cmdf "_rotate" bueg "" KlB12 270) 
  (vl-cmdf "_move" bueg "" KlB12 KlB14)(ssadd bueg Garde) 
  
  (if (= Ablag 1)(vl-cmdf "_mirror" Garde "" MirPt1 MirPt2 "j"))
 ; (setvar "ORTHOMODE" 1)
  (terpri)
  (princ)
  (princ "\n Einfügepunkt für die Garderobe: ")
  (command-s "_move" Garde "" Pt6 PAUSE)
  (terpri)(princ)
  (vl-cmdf "_.view" "H" "TE_VIEW")
  (vl-cmdf "_.zoom" "G" "_.zoom" "0.8x")
  (vl-cmdf "_.view" "Lö" "TE_VIEW")
)
(defun DO_TB (in)
(setq TB_VAL (atof in))
  (setq TB TB_VAL GardeBr (+ TB Td MaB))
  (set_tile "TX1" (rtos GardeBr 2 0))
  (set_tile "DTB" (rtos TB 2 0))
  (set_tile "DTD" (rtos TD 2 0))
  (set_tile "DMaB" (rtos MaB 2 0))
)
(defun DO_TD (in)
(setq TD_VAL (atof in))
  (setq TD TD_VAL GardeBr (+ TB Td MaB))
  (set_tile "TX1" (rtos GardeBr 2 0))
  (set_tile "DTB" (rtos TB 2 0))
  (set_tile "DTD" (rtos TD 2 0))
  (set_tile "DMaB" (rtos MaB 2 0))
)
(defun DO_TMaB (in)
(setq TMaB_VAL (atof in))
  (setq MaB TMaB_VAL GardeBr (+ TB Td MaB))
  (set_tile "TX1" (rtos GardeBr 2 0))
  (set_tile "DTB" (rtos TB 2 0))
  (set_tile "DTD" (rtos TD 2 0))
  (set_tile "DMaB" (rtos MaB 2 0))
)
(defun DO_Einbog0 (in)
(setq Einbog_VAL (atof in))
(if (= Einbog_VAL 1)  (progn (setq Einbog 0)
	(set_tile "DEinbog0" "1")(set_tile "DEinbog1" "0")(mode_tile "DGarAbstBod" 1)))
) 
(defun DO_Einbog1 (in)
(setq Einbog_VAL (atof in))
(if (= Einbog_VAL 1)  (progn (setq Einbog 1)
	(set_tile "DEinbog0" "0")(set_tile "DEinbog1" "1")(mode_tile "DGarAbstBod" 0)))
)
(defun DO_Ablag0 (in)
(setq Ablag_VAL (atof in))
(if (= Ablag_VAL 1)  (progn (setq Ablag 0 Dn "1")
		     (set_tile "DAblag0" "1")(set_tile "DAblag1" "0"))) 
	(setq brei (dimx_tile "DIA"))
    	(setq hoe (dimy_tile "DIA"))
    	(start_image "DIA")
    	(fill_image 0 0 brei hoe -2)
    	(slide_image -35 -80 600 560 (strcat "garderob(garderob"Dn "))"))
	(end_image)  
) 
(defun DO_Ablag1 (in)
(setq Ablag_VAL (atof in))
(if (= Ablag_VAL 1)  (progn (setq Ablag 1 Dn "2")
		     (set_tile "DAblag0" "0")(set_tile "DAblag1" "1")))
  	(setq brei (dimx_tile "DIA"))
    	(setq hoe (dimy_tile "DIA"))
    	(start_image "DIA")
    	(fill_image 0 0 brei hoe -2)
    	(slide_image -45 -220 600 700 (strcat "garderob(garderob"Dn "))"))
	(end_image)
)
(defun Te:Quad (CP laenge breite hoehe)
    (setq GarderobObj (vlax-get-acad-object))
    (setq Holzliste (vla-get-ActiveDocument  GarderobObj))
    (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 aib (w) (* pi (/ w 180.0)))
(defun Te:GarderobBack ()
  (setvar "CMDECHO" cealt)
  (setvar "MENUECHO" mealt)
  (setvar "OSMODE"  osalt)
  (setvar "CLAYER"  layalt)
  (setvar "CECOLOR" coalt)
  (setvar "ORTHOMODE" ortalt)
  (setvar "DELOBJ" delalt)
)
(defun C:Garderob ( / dcl_id cealt mealt osalt ortalt layalt coalt delalt TB Tt TH RBD TD MaB GsH Einbog
		   GarAbstBod EliB EliL SubKBr RegSeitD Ablag GardeBr Fug Dn EP next fil1 IMG1 brei hoe FuH
		   Wi Wio Wiu Wir Garde Pt1 Pt2 Pt3 Pt4 Pt5 Pt6 px py elibog pli rbod regbod movlist
		   movlist2 RegSeit regbod2 GPt1 GPt2 GPt3 GPt4 GPt5 GPt6 GPt7 GPt8 nPt4 elibog2 elibog3
		   lin pli2 Gseit Gseite mPt1 mPt2 mPt3 mPt4 mPt5 mPt6 mPt7 mPt8 KlPt1 KlPt2 KlPt3 KlPt4
		   KlPt5 KlPt6 KlPt7 GardeBr GardeBr2 MirPt1 MirPt2 linHal1 linHal2 linHal elibog4 pli3
		   MBod Kl_Stan KlB1 KlB2 KlB3 KlB4 KlB5 KlB6 KlB7 KlB8 KlB9 KlB10 KlB11 KlB12 KlB13 KlB14
		   bueg1 bueg2 bueg3 bueg TD_VAL TB_VAL TMaB_VAL Einbog_VAL Ablag_VAL GarderobObj Holzliste
		   px py pz MP modelSpace QuadObj)
  
  (Te:GarderobIni)
  
(setq TB 800      ; Regalbreite
      Tt 400      ; Regaltiefe
      TH 140      ; Regalhöhe
      RBD 20      ; Regalbrettdicke
      RAbst 770   ; Regal Abstand Boden
      TD 25       ; Dicke Garderobenseite
      MaB 375     ; Breite Mützenablage
      GsH 1700    ; Höhe Mützenablage
      Einbog 0    ; Bogen 0 oben  1 oben + unten
      GarAbstBod 300 ; Garderobenseite Abstand vom boden
      EliB 40     ; Ellipsenbreite
      EliL 100    ; Ellipsenlänge
      SubKBr 400  ; SchubKastenBreite
      RegSeitD 16 ; Regalseitendicke
      Ablag 0     ; Ablage links = 0  rechts 1
      GardeBr 1200 ; Gesamtbreite Garderobe
      Fug 2       ; Schubkastenfuge
      Dn "1"	  ; Dianummer
)
  (setq EP '(0.0 0.0 0.0))
	(Te:GarderobDlg)
	(Te:GarderobBack)
  	(princ)
  )
  (princ "\n  Copyright (c) 2025 Thomas Elbracht ")
  (princ "\n  Starten Sie mit dem Befehl << Garderob >>  ")
   (terpri)(princ)