;;;  Dateiname: Garderobe.lsp  -  erstellt: Thomas Elbracht
;;;  12.2023  -  für AC2023               mail: te@elbracht-web.de
;;;  Aufruf mit: Garderobe
;;;
;;;  Die Routine erstellt eine Garderobe für den Einrichtungsplaner
;;
  (defun Te:GarderobeIni ()
  ; 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:GarderobeDlg ()
(setq next 4)
(setq	IMG1 "Garderobe(logo)"
	fil1 IMG1
  ) 
(if (not dcl_id) (setq dcl_id (load_dialog "Garderobe")))

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

	(setq brei (dimx_tile "DIA"))
    	(setq hoe (dimy_tile "DIA"))
    	(start_image "DIA")
    	(fill_image 0 0 brei hoe -2)
    	(slide_image 5 -54 500 500 "Garderobe(Garderobe1)")
	(end_image)
 
    (start_image "IMG1") 
    (slide_image 180 -45 180 132 fil1)
    (end_image)
    (Te:PlAbr PlAbr)
    (set_tile "DGgB" (rtos GgB 2 0))
    (set_tile "DGB" (rtos GB 2 0))
    (set_tile "DGH" (rtos GH 2 0))
    (set_tile "DGD" (rtos GD 2 0))
    (set_tile "DAbstB" (rtos AbstB 2 0))
    (set_tile "DPlAbr" PlAbr)
    (set_tile "DPlRa" (rtos PlRa 2 0))
    (set_tile "DAbstH" (rtos AbstH 2 0))
    (set_tile "DAbsHaLi" (rtos AbsHaLi 2 0))
    (set_tile "DAnzHak" (rtos AnzHak 2 0))
    (set_tile "DAblBr" (rtos AblBr 2 0))
    
    (action_tile "DGgB" "(setq GgB (atof $value))")
    (action_tile "DGB" "(DO_GB)")
    (action_tile "DGH" "(setq GH (atof $value))")
    (action_tile "DGD" "(setq GD (atof $value))")
    (action_tile "DAbstB" "(setq AbstB (atof $value))")
    (action_tile "DPlAbr" "(Te:PlAbr $value)")    
    (action_tile "DPlRa" "(setq PlRa (atof $value))")

    (action_tile "DAbstH" "(setq AbstH (atof $value))")
    (action_tile "DAbsHaLi" "(setq AbsHaLi (atof $value))")
    (action_tile "DAnzHak" "(DO_AnzHak)")
 
    (action_tile "DAblBr" "(DO_AblBr)")

    (action_tile "ABLfrag" "(done_dialog 5)")
    (action_tile "accept" "(done_dialog 1)")
    (action_tile "cancel" "(done_dialog 0)")
(setq next (start_dialog))
    (if	(= next 5)(DO_Ablag) )
    (if (= next 1) 
  (Te:GarderobeZeich)
  (Te:GarderobeBack)
  )
    )
  (unload_dialog dcl_id)
)
(defun DO_Ablag ()
  (new_dialog "Ablag2" dcl_id)
  	(setq brei2 (dimx_tile "DIA"))
    	(setq hoe2 (dimy_tile "DIA"))
    	(start_image "DIA")
    	(fill_image 0 0 brei2 hoe2 -2)
    	(slide_image 5 -30 450 430 "Garderobe(Garderobe2)")
	(end_image)
  
    (set_tile "DAblBr" (rtos AblBr 2 0))
    (set_tile "DAblH" (rtos AblH 2 0))
    (set_tile "DAblT" (rtos AblT 2 0))
    (set_tile "DMatD" (rtos MatD 2 0))
    (set_tile "DAbsSeMi" (rtos AbsSeMi 2 0))
    (set_tile "DSPh" (rtos SPh 2 0))
    (set_tile "DSpRa" (rtos SpRa 2 0))
    (set_tile "DSpMatD" (rtos SpMatD 2 0))
  
    (action_tile "DAblBr" "(DO_AblBr)")
    (action_tile "DAblH" "(setq AblH (atof $value))")
    (action_tile "DAblT" "(setq AblT (atof $value))")
    (action_tile "DMatD" "(setq MatD (atof $value))")
    (action_tile "DAbsSeMi" "(setq AbsSeMi (atof $value))")
    (action_tile "DSPh" "(setq SPh (atof $value))")
    (action_tile "DSpRa" "(setq SpRa (atof $value))")
    (action_tile "DSpMatD" "(setq SpMatD (atof $value))")

  (start_dialog)
)
(defun Te:GarderobeZeich ()
  (vl-load-com)
  (vl-cmdf "_.view" "S" "TE_VIEW")
  (vl-cmdf "_.UCS" "EN" "SP" "AnsOrig")
  (vl-cmdf "_.UCS" "W")
  (vl-cmdf "_.PLAN" "W")
  (setvar "CMDECHO" 0)
  (command-s "LAYER" "_M" "Te_Garderobe" "_CO" "42" "Te_Garderobe" "")

  (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 unten  "))
(Te:G-Platte)

  )
(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)
  (progn
    (mode_tile "DPlRa" 1)(setq PlRa 0)
        (set_tile "DPlRa" (rtos PlRa 2 0))
    )
       )
 )
(defun DO_AnzHak ()
(setq AnzHak (atof $value))
(if (< AnzHak 2)(alert "2 Haken sollten es mindestens sein "))
      (set_tile "DAnzHak" (rtos AnzHak 2 0))
)  
(defun DO_GB ()
  (setq GB (atof $value))
(setq GgB (+ Gb AblBr))
 (set_tile "DGgB" (rtos GgB 2 0))(set_tile "DGB" (rtos GB 2 0))
)
(defun DO_AblBr ()
  (setq AblBr (atof $value))
(setq GgB (+ Gb AblBr))
 (set_tile "DGgB" (rtos GgB 2 0))(set_tile "DAblBr" (rtos AblBr 2 0))
)  
(defun Te:G-Platte ()
    (vl-cmdf "_pline" "-128.3637,-44.3083" "-14.2056,-1.0387" "k" "p" "-11.4173,-0.2618" "-8.5347,0.0" "li"
	   "8.5347,0.0" "k" "p" "33.5347,-25.0" "8.5347,-50.0" "li" "8.5347,-44.0" "k" "p"
	   "27.5347,-25.0" "8.5347,-6.0" "li" "-8.5347,-6.0" "k" "p" "-10.3363,-6.1636" "-12.0790,-6.6492"
	   "li" "-126.4653,-50.00" "s")
  (setq hak (entlast))
   (vl-cmdf "CECOLOR" 153)	

  (vl-cmdf "_extrude" hak "" 20.0)
  (vl-cmdf "CECOLOR" coalt)

  (setq hakn (entlast))
  (vl-cmdf "_.MOVE" hakn "" (polar EP Wiu GD) "")
(setq BKV1 (list (car EP)(cadr EP)(+(caddr EP)10))
      BKV2 (list (+(car EP)100)(cadr EP)(caddr EP))
      BKV3 (list (car EP)(cadr EP)(+(caddr EP)100))
      )
  (vl-cmdf "_.UCS" "3P" EP BKV2 BKV3)
  (vl-cmdf "_.PLAN" "")
  (vl-cmdf "_.UCS" "EN" "SP" "Ans")
  (vl-cmdf "_rotate" hakn "" "0,0,10" "-90")

   (setq nEP (trans EP 0 1))
   (setq PtReL (list (car nEP)(+(cadr nEP)AbstB)(caddr nEP))
	 PtReR (list (+(car nEP)GB)(+(cadr nEP) GH)(caddr nEP)))
   (vl-cmdf "_.RECTANGLE" PtReL PtReR)
  (if (> PlRa 0)(progn
   (vl-cmdf "_.FILLET" "R" PlRa)   (vl-cmdf "_.FILLET" "P" (entlast))
   ))
      (vl-cmdf "_extrude" (entlast) "" GD)

   (setq AbstHak (/ (- GB (* (+ AbsHaLi 10.0)2.0))(- AnzHak 1))) 
   (vl-cmdf "_.MOVE" hakn "" (list (+(car nEP) AbsHaLi) (+(cadr nEP)AbstH)(caddr nEP)) "")
  
(vl-cmdf "_.MIRROR" hakn "" (list (+(car PtReL)(/ GB 2.0)) (+(cadr nEP)AbstH)(caddr nEP))
	 (list (+(car PtReL)(/ GB 2.0))(cadr nEP)(caddr nEP)) "")
(setq n 1 AnzHakN(- AnzHak 1))
  (while (/= AnzHakN n)
(vl-cmdf "_.COPY" hakn "" (list(+(car nEP) AbsHaLi 10.0)(+(cadr nEP)AbstH)(caddr nEP))
	 (list (+(car nEP) AbsHaLi 10.0 (* AbstHak n))(+(cadr nEP)AbstH)(caddr nEP)))
  (setq n (1+ n))
    )
  
  (setq PtAbReL (list (+(car nEP)GB) (+(cadr nEP)AbstB)(caddr nEP))
	PtAbReR (list (+(car nEP)GB AblBr)(+(cadr nEP) AbstB AblH)(caddr nEP))
	PtAbReLi (list (+(car PtAbReL)MatD) (+(cadr PtAbReL)MatD)(caddr nEP))
	PtAbReRi (list (-(car PtAbReR)MatD)(-(cadr PtAbReR) MatD)(caddr nEP))
	PtAbReMi (list (+(car PtAbReLi) AbsSeMi)(cadr PtAbReLi)(+(caddr nEP)AblT))
	)
			
(vl-cmdf "_.RECTANGLE" PtAbReL PtAbReR)
  (if (> PlRa 0)(progn
   (vl-cmdf "_.FILLET" "R" PlRa)(vl-cmdf "_.FILLET" "P" (entlast))
   ))
(vl-cmdf "_.REGION" (entlast) "")
  (setq ReAuss (entlast))

  (vl-cmdf "_.RECTANGLE" PtAbReLi PtAbReRi)
    (if (> PlRa 0)(progn
      (vl-cmdf "_.FILLET" "R" (- PlRa MatD))(vl-cmdf "_.FILLET" "P" (entlast))
    ))
  (vl-cmdf "_.REGION" (entlast) "")
  (setq ReInn (entlast))
  
  (vl-cmdf "_SUBTRACT" ReAuss "" ReInn "")
  (vl-cmdf "_EXTRUDE" (entlast) "" AblT)
  (setq AblagKon (entlast))

  (vl-cmdf "_.UCS" "W")
 (Te:Quad EP MatD  AblT (- AblH (* MatD 2.0)))

 (setq EP '(100.0 500.0 0.0))
 (vl-cmdf "_.UCS" "EN" "HO" "Ans")
 (vl-cmdf "_.MOVE" (entlast) "" nEP PtAbReMi)
 (setq CylEP (list (+(car PtAbReL)(/ AblBr 2.0))(+(cadr nEP)SPh)(caddr PtAbReL)))

  (vl-cmdf "CECOLOR" 141)	
  (vl-cmdf "_cylinder" CylEP SpRa SPMatD)
  (vl-cmdf "CECOLOR" coalt)

  (vl-cmdf "_.view" "_R" "TE_VIEW")
  (vl-cmdf "_.UCS" "EN" "HO" "AnsOrig")
  
  (vl-cmdf "_.UCS" "EN" "LÖ" "Ans")
  (vl-cmdf "_.UCS" "EN" "LÖ" "AnsOrig")

  (vl-cmdf "_.view" "LÖ" "TE_VIEW")

  )
(defun Te:Quad (CP laenge breite hoehe)
    (setq GardObj (vlax-get-acad-object))
    (setq Holzliste (vla-get-ActiveDocument  GardObj))
     (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:GarderobeBack ()
  (setvar "CMDECHO" cealt)
  (setvar "MENUECHO" mealt)
  (setvar "OSMODE"  osalt)
  (setvar "CLAYER"  layalt)
  (setvar "CECOLOR" coalt)
  (setvar "ORTHOMODE" ortalt)
  (setvar "DELOBJ" delalt)
)
(defun C:Garderobe ( / dcl_id cealt mealt osalt ortalt layalt coalt delalt GgB GB GH AbstB PlAbr PlRa AbsHaLi
		    AbstH AblBr AblH AblT AbsSeMi MatD SPh SPRa SPMatD fil1 IMG1 next brei hoe Wi Wio Wiu Wir
		    EP hak hakn BKV1 BKV2 BKV3 nEP PtReL PtReR AbstHak n AnzHakN PtAbReL PtAbReR PtAbReLi
		    PtAbReRi PtAbReMi ReAuss ReInn AblagKon CylEP GardObj Holzliste px py pz MP modelSpace
		    QuadObj)		  

  (Te:GarderobeIni)
  
(setq GgB 1800    ; Garderobengesamtbreite
      GB 800      ; Garderobenbreite
      GH 1800     ; Garderobenhöhe
      GD 20       ; Dicke Garderobenplatte
      AbstB 520   ; Abstand vom Boden
      PlAbr "1"   ; Plattenabrundung
      PlRa 50     ; Radius Plattenabrundung
      AbsHaLi 120 ; Abstand Haken vom Rand
      AbstH 1600  ; HakenHöhe
      AnzHak 4    ; Anzahl Haken
      AblBr 1000  ; Ablagenbreite
      AblH 180    ; Ablagenhöhe
      AblT 250    ; Ablagentiefe
      AbsSeMi 630 ; Abstand Mittelseite
      MatD 20     ; Materialdicke
      SPh 1400    ; Spiegelhöhe
      SpRa 350    ; Spiegelradius
      SpMatD 6    ; Spiegeldicke
      )

  (Te:GarderobeDlg)
  (Te:GarderobeBack)
  (vl-cmdf "_.ZOOM" "G")
  (princ)
   )
  (princ "\n  Copyright (c) 2023 Thomas Elbracht ")
  (princ "\n  Starten Sie mit dem Befehl << Garderobe >>  ")
  
  (princ)
