;;;  Dateiname: handtuchregal.lsp  -  erstellt: Thomas Elbracht
;;;  9.2025  -  für AC2023           mail: te@elbracht-web.de
;;;  Aufruf mit: handtuchregal
;;;
;;;  Die Routine erstellt ein Handtuchregal 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:handtuchregalIni ()
  
  (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" 2)
  	(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)
  (setvar "ORTHOMODE" ortalt)
  (setvar "CLAYER"  layalt)
  (setvar "CECOLOR" coalt)
  (setvar "ORTHOMODE" ortalt)
  (setvar "DELOBJ" delalt)
     
    (if	*te:error*
      (setq *error* *te:error*)	
      (setq *error* nil)
    )
    (princ)
  )
nil
)
(defun TE:handtuchregalDlg ()
(setq next 4)

(if (not dcl_id) (setq dcl_id (load_dialog "handtuchregal")))

  (while (> next 1)
  (new_dialog "handtuchregal" dcl_id)
  (setq brei (dimx_tile "DIA"))
  (setq hoe (dimy_tile "DIA"))
  (start_image "DIA")
  (fill_image 0 0 brei hoe -2)
  (slide_image 2 -25 350 332 (strcat "handtuchregal(handtuchregal)"))
  (end_image)

    (setq IMG1 "handtuchregal(logo)"
      fil1 IMG1)    
    (start_image "IMG1") 
    (slide_image 75 -43 180 130 fil1)
    (end_image)
    (set_tile "DRB" (rtos RB 2 0))
    (set_tile "DRH" (rtos RH 2 0))
    (set_tile "DRT" (rtos RT 2 0))
    (set_tile "DAbstBod" (rtos AbstBod 2 0))
    (set_tile "DHBr" (rtos HBr 2 0))
    (set_tile "DHSt" (rtos HSt 2 0))
    (set_tile "DAnzAbl" (rtos AnzAbl 2 0))
    (set_tile "DAbstAbl" (rtos AbstAbl 2 0))
    (set_tile "DAnzAblStan" (rtos AnzAblStan 2 0))
    (set_tile "DUebObUn" (rtos UebObUn 2 0))
    (set_tile "DHant" Hant)
    (set_tile "DHak" Hak)
    (set_tile "DZO" ZO)
  
    (action_tile "DRB" "(setq RB (atoi $value))")
    (action_tile "DRH" "(setq RH (atoi $value))")
    (action_tile "DRT" "(setq RT (atoi $value))")
    (action_tile "DAbstBod" "(setq AbstBod (atoi $value))")
    (action_tile "DHBr" "(setq HBr (atoi $value))")  
    (action_tile "DHSt" "(DO_HSt $value)")
    (action_tile "DAnzAbl" "(DO_AnzAbl $value)")
    (action_tile "DAbstAbl" "(DO_AbstAbl $value)")
    (action_tile "DAnzAblStan" "(setq AnzAblStan (atoi $value))")
    (action_tile "DUebObUn" "(DO_UebObUn $value)")
    (action_tile "DHant" "(setq Hant $value)")
    (action_tile "DHak" "(setq Hak $value)")
    (action_tile "DZO" "(setq ZO $value)")
    (action_tile "accept" "(done_dialog 1)")
    (action_tile "cancel" "(done_dialog 0)")
   
(setq next (start_dialog))
(if (= next 2) (TE:handtuchregalDEP))
(if (= next 1)
      (TE:handtuchregalZeich)
      (TE:handtuchregalBack)
  )
    )
  (unload_dialog dcl_id)
)
s(defun TE:handtuchregalZeich ()
  (vl-load-com)
  (vl-cmdf "_.view" "S" "TE_VIEW")
  (vl-cmdf "_vpoint" "d" 270.0 90.0)
  (vl-cmdf "_.UCS" "")
  (vl-cmdf "_.PLAN" "")
  (setq layregal "Te_Handtuchregal")
  (vl-cmdf "_.LAYER" "_M" layregal "_CO" "35" "" "")
  (setq EP (getpoint "\n Einfügepunkt angeben, hinten links   "))
  (arxload "geom3d")
  (setvar "OSMODE" 0)
  (setvar "ORTHOMODE" 0)

  (setq Wil (aib 180) Wio (aib 90.0) Wiu (aib 270.0) Wir 0.0)
  (setq ss (ssadd))
  (setq EP (list (car EP)(-(cadr EP)HBr)(+(caddr EP)AbstBod)))

  (Te:Platte EP HBr HSt RH) (setq ss (ssadd (entlast) ss))
  (Te:Platte (list (car EP)(-(cadr EP)RT)(+(caddr EP)(- RH UebObUn HSt))) HBr RT HSt)(setq ss (ssadd (entlast) ss))
  (setq SeitEP (list (car EP)(-(cadr EP)RT)(+(caddr EP) UebObUn))) 
  (Te:Platte SeitEP HBr RT HSt) (setq ss (ssadd (entlast) ss))
(if (> AnzAbl 2)
  (progn
  (setq a 2)
  (setq SeitEP1 (list (car SeitEP)(cadr SeitEP)(+(caddr SeitEP) AbstAbl HSt)))
(while (/= a AnzAbl)
   (Te:Platte SeitEP1 HBr RT HSt) (setq ss (ssadd (entlast) ss))
  (setq SeitEP1 (list (car SeitEP)(cadr SeitEP)(+(caddr SeitEP1) AbstAbl HSt)))
  (setq a (1+ a))
  )
  ))
  (vl-cmdf "_.copy" ss "" EP (polar EP Wir (- RB HBr)))

  (setq RT2 (/ (- RT HBr)AnzAblStan) RT3 (/(- RT (* HBr 4.0))AnzAblStan))
  (setq Stan1EP (list (+(car EP)HBr)(+(-(cadr EP)RT) (* HBr 1.5))(+(caddr EP) (- RH UebObUn HSt)(/ HSt 2.0))))
  (TE:Cyl Stan1EP 6 (- RB (* HBr 2)))
  (setq stange1 (entlast))
  (rotate3d stange1 "" Stan1EP (polar Stan1EP Wio 100) 90)
  (vl-cmdf "-reihe" stange1 "" "" AnzAblStan "" RT2)

  (setq TravEP (list (+(car EP)HBr)(-(cadr EP)RT)(+(caddr EP) UebObUn)))
  (Te:Platte TravEP (- RB (* HBr 2)) HBr HSt)(setq TravOb (entlast))

  (setq Stan2EP (list (car TravEP)(+(-(cadr EP)RT) (* HBr 2.0))(+(caddr EP) UebObUn (/ HSt 2.0))))
  (TE:Cyl Stan2EP 6 (- RB (* HBr 2)))
  (setq stange2 (entlast))
  (rotate3d stange2 "" Stan2EP (polar Stan2EP Wio 100) 90)
  (vl-cmdf "-reihe" stange2 "" "" AnzAblStan "" RT2)
  
  (if (> AnzAbl 2)
  (progn
      (setq TravEP1 (list (car TravEP) (cadr TravEP) (+(caddr TravEP) AbstAbl HSt)))
     (setq b 2)
(while (/= b AnzAbl)
  (vl-cmdf "_.copy" TravOb stange2 "" TravEP TravEP1)(setq stan (entlast))
  (vl-cmdf "-reihe" stan "" "" AnzAblStan "" RT2)
  (setq TravEP1 (list (car TravEP)(cadr TravEP)(+(caddr TravEP1) AbstAbl HSt)))
  (setq b (1+ b))
  ))
  )

  (if (= Hak "1")
   (TE:handtuchhak)
    )
 (if (= Hant "1") (TE:handtucheinfueg))
  
  (vl-cmdf "_.view" "H" "TE_VIEW")
  (vl-cmdf "_.zoom" "G" "_.zoom" "0.8x")
  (vl-cmdf "_.view" "Lö" "TE_VIEW")

  (if (= ZO "1")(Te:handtuchregalZom))
)
(defun TE:handtucheinfueg ()

  (vl-cmdf "_.LAYER" "_M" "Te_Handtuch" "_CO" "103" "" "")
  (vl-cmdf "_spline" "0,0,0" "80.1039,1.1944,0.0" "158.4396,-2.4522,0.0" "239.0020,-3.8525,0.0" "320.0,0.0,0.0" "" "" "")
  (if (/= RB 320)
  (vl-cmdf "varia" (entlast) "" "0,0,0" "b" "0,0,0" "320.0,0.0,0.0" RB)
    )
  (setq handt_pfad (entlast))

(vl-cmdf "_pline" "-20.0,20.0" "k" "p" "0,0" "20.0,20.0" "li" "20.0,231.0" "k" "p" "10.9830,240.0" "1.9660,231.0341"
	 "li" "1.1667,20.0" "k" "p" "0.1667,19.0" "-0.8333,20.0" "li" "1.8660,231.0341" "k" "p" "-7.2176,240.0"
	 "-16.4013,231.0" "s")
  (if (/= RT 240)
  (vl-cmdf "varia" (entlast) "" "0,0,0" "b" "0,0,0" "0.0,240.0,0.0" RT)
    )
  (setq handt_contur (entlast))
  (rotate3d handt_contur "" '(0.0 0.0 0.0) (polar '(0.0 0.0 0.0) Wio 100) 90)
  (setvar "DELOBJ" 2)
  (vl-cmdf "_extrude" handt_contur "" "p" handt_pfad)(setq handt (entlast))
  (setvar "DELOBJ" delalt)
  (setvar "CLAYER"  layregal)
  (vl-cmdf "_.move" handt "" '(0.0 0.0 0.0) (list (car EP)(-(cadr EP)RT 2)(+(caddr EP)(- RH UebObUn) 20.0)))

)
(defun TE:handtuchhak ()
  (setq HBr2 (/ HBr 2.0) HBr4 (/ HBr 4.0))
  (setq PlEP (list (+(car EP)HBr2 (- RB HBr))(-(cadr EP)RT)(+(caddr EP)(- RH UebObUn HSt)))
	PlEP2 (polar PlEP Wir HBr)
	PlEP3 (list (+(car PlEP2)85.0)(+(cadr PlEP)HBr4)(caddr PlEP))
	PlEP4 (list (+(car PlEP3)HBr4)(+(cadr PlEP3)HBr4)(caddr PlEP))
	PlEP5 (list (-(car PlEP4)HBr4)(+(cadr PlEP4)HBr4)(caddr PlEP))
	PlEP6 (polar PlEP2 Wio HBr)
	PlEP7 (polar PlEP Wio HBr)
	PlEP8 (list (-(car PlEP)HBr2)(+(cadr PlEP)HBr2)(caddr PlEP))
	PlEP9 (list (+(car PlEP2)75.0)(cadr PlEP)(+(caddr PlEP) HSt))
	)

(vl-cmdf "_pline" PlEP PlEP2 PlEP3 "k" "p" PlEP4 PlEP5 "li" PlEP6 PlEP7 "k" "p" PlEP8  PlEP "s" )
(setq hak1 (entlast))
  (vl-cmdf "_extrude" hak1 "" HSt)(setq hak1 (entlast))

  (TE:Cyl PlEP9 8.0 HSt)(setq hak2 (entlast))

  (rotate3d hak2 "" PlEP9 (polar PlEP9 Wir 100) -90)
  (vl-cmdf "_SUBTRACT" hak1 "" hak2 "")(setq hak1 (entlast))
  (vl-cmdf "_rotate" hak1 "" (polar PlEP Wio HBr2) -45)
)
(defun DO_AnzAbl (in)
  (setq AnzAbl (atoi in))
  (if (< AnzAbl 2)
    (progn (setq AnzAbl 2)
    (setq RH (+(* HST 2.0)(* UebObUn 2.0)AbstAbl))
      )
    (setq RH (+(* HST AnzAbl)(* UebObUn 2.0)(* AbstAbl (- AnzAbl 1))))
    )
 (set_tile "DRH" (rtos RH 2 0))(set_tile "DAnzAbl" (rtos AnzAbl 2 0))
)
(defun DO_HSt (in)
(setq HSt (atoi in))
  (setq RH (+(* HSt AnzAbl)(* UebObUn 2.0)(* AbstAbl (- AnzAbl 1))))
  (set_tile "DRH" (rtos RH 2 0))
)
(defun DO_AbstAbl (in)
(setq AbstAbl (atoi in))
  (setq RH (+(* HSt AnzAbl)(* UebObUn 2.0)(* AbstAbl (- AnzAbl 1))))
 (set_tile "DRH" (rtos RH 2 0))
)
(defun DO_UebObUn (in)
(setq UebObUn (atoi in))
 (setq RH (+(* HSt AnzAbl)(* UebObUn 2.0)(* AbstAbl (- AnzAbl 1))))
 (set_tile "DRH" (rtos RH 2 0))
)
(defun Te:handtuchregalZom ()

  (vl-cmdf "_ZOOM" "_W" (getvar "EXTMIN") (getvar "EXTMAX"))
	(command "_ZOOM" "0.95x")
        (command "_REGEN")
)
(defun Te:handtuchregalDEP ()
  (setq EP (getpoint "\nGeben Sie den Einfügepunkt an: " )
	px (car EP)
	py (cadr EP)
	pz (caddr EP))
)
(defun Te:Platte (CP laenge breite hoehe)
  (setq SchrankObj (vlax-get-acad-object))
  (setq Holzliste (vla-get-ActiveDocument SchrankObj))
  (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 PlatteObj (vla-AddBox modelSpace MP laenge breite hoehe))
)
(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 aib (w) (* pi (/ w 180.0)))
(defun Te:handtuchregalBack ()
  (setvar "CMDECHO" cealt)
  (setvar "MENUECHO" mealt)
  (setvar "OSMODE"  osalt)
  (setvar "ORTHOMODE" ortalt)
  (setvar "CLAYER"  layalt)
  (setvar "CECOLOR" coalt)  
  (princ)
)
(defun C:handtuchregal ( / dcl_id cealt mealt osalt ortalt layalt coalt delalt next px py pz EP IMG1
			fil1 brei hoe RB RH RT AbstBod HBr HSt AnzAbl AbstAbl AnzAblStan UebObUn Hant
			Hak ZO Dn Wil Wio Wiu Wir layregal ss SeitEP a SeitEP1 RT2 RT3 Stan1EP stange1
			TravEP Stan2EP Stan2EP stange2 TravEP1 b handt_pfad handt_contur HBr2 HBr4
			PlEP PlEP2 PlEP3 PlEP4 PlEP4 PlEP5 PlEP6 PlEP7 PlEP8 PlEP9 hak1 hak2 SchrankObj
			Holzliste MP modelSpace PlatteObj KnEP cylRad cylHoch cylObj cylist ex ey ez PC)

  (Te:handtuchregalIni)

  (setq RB 320      ; Regalbreite
	RH 258      ; Regalhöhe
	RT 240      ; Regaltiefe
	AbstBod 1100 ; Abstand vom Boden
	HBr 24      ; Holzbreite
	HSt 24      ; Holzstärke
        AnzAbl  2   ; Anzahl Ablagen
	AbstAbl 130 ; Abstand Ablagen
	AnzAblStan 3 ; Anzahl Stangen je Ablage
	UebObUn 40  ; Überstand 
	Hant "1" ; Handtuch
	Hak "1"  ; Haken
        ZO "1"  ; Zoomen
        Dn "1"  ; Dianummer
        EP '(0.0 0.0 0.0)
	px (car EP)
	py (cadr EP)
	pz (caddr EP)
	)

  (Te:handtuchregalDlg)
  (Te:handtuchregalBack)
(princ)
  )
  (princ "\n  Copyright (c) 2o25 Thomas Elbracht ")
  (princ "\n \t  Aufruf mit handtuchregal")
(princ)