(vl-load-com)

(defun  infoBox(volajObj reactorObj paramList / )
  (if (vlax-property-available-p volajObj "Volume")
   (progn
    (setq objemNovy (vla-get-volume volajObj))
    (setq objemStary (vlr-data reactorObj))
    (if (> objemNovy objemStary)
      (alert
	(strcat "Objem krychle se zvětšil "
		(rtos (/ objemNovy objemStary)) " krát."
        )
      )
      (alert
	(strcat "Objem krychle se zmenšil "
		(rtos (/ objemStary objemNovy)) " krát."
	)
      )
    )
    (vlr-data-set reactorObj objemNovy)
   )
  )
)


(defun c:reaktorBox ()
;;; definice nové funkce spustitelné jako příkaz AutoCADu
  (setq	gl_pam_hodnoty	;;; globální proměnná uchovávající jednotlivá nastavení
     (list
	(cons "stredx" "0.0")		;;; x-ova souřadnice středu kvádru
	(cons "stredy" "0.0")		;;; y-ova souřadnice středu kvádru
	(cons "stredz" "0.0")		;;; z-ova souřadnice středu kvádru
	(cons "delka"    "1")		;;; délka kvádru
	(cons "sirka"    "1")		;;; sirka kvádru
	(cons "vyska"    "1")		;;; vyska kvádru
     )
  )

  (if	(= (rb:dialog) T)
    (rb:kresli_box)		;;; vykreslení požadovaného objektu,
      				;;; v případě že byly zadány hodnoty správně
  )

  (princ "Funkce reaktor box dokončila činnost")	;;; informace o ukončení funkce
  (princ)
)

 
(defun rb:dialog (/ id co_delat vysledek)
  (setq id (load_dialog "D:/dialogBox.dcl"))	;;; předání jména dialogového boxu
    ;;; CESTU K UMÍSTĚNÍ DIALOGU SE MUSÍ AKTUALIZOVAT PODLE AKTUALNÍHO UMÍSTĚNÍ
  (setq co_delat 2)
  (while (>= co_delat 2)			;;; opakuj pokud nenastane zmena
    (if	(not (new_dialog "dialogBox" id))	;;; není-li jméno dialogu vyber tak skonči
      (exit)
    )
    ;;; nastavení hodnot dialogových prvků
    (set_tile "delka"  (cdr (assoc "delka"  gl_pam_hodnoty)))
    (set_tile "sirka"  (cdr (assoc "sirka"  gl_pam_hodnoty)))
    (set_tile "vyska"  (cdr (assoc "vyska"  gl_pam_hodnoty)))
    (set_tile "stredx" (cdr (assoc "stredx" gl_pam_hodnoty)))
    (set_tile "stredy" (cdr (assoc "stredy" gl_pam_hodnoty)))
    (set_tile "stredz" (cdr (assoc "stredz" gl_pam_hodnoty)))

    (action_tile "stredx"
       "(setq gl_pam_hodnoty
        (subst
          (cons \"stredx\" $value)
          (assoc \"stredx\" gl_pam_hodnoty)
          gl_pam_hodnoty
        ))"
    )
    (action_tile "stredy"
       "(setq gl_pam_hodnoty
        (subst
          (cons \"stredy\" $value)
          (assoc \"stredy\" gl_pam_hodnoty)
          gl_pam_hodnoty
        ))"
    )
    (action_tile "stredz"
       "(setq gl_pam_hodnoty
        (subst
          (cons \"stredz\" $value)
          (assoc \"stredz\" gl_pam_hodnoty)
          gl_pam_hodnoty
        ))"
    )
		;;; je-li změněn některý editbox středu kružnice nastav odpovídající hodnoty
    (action_tile "delka"
	"(setq gl_pam_hodnoty
        (subst
          (cons \"delka\" $value)
          (assoc \"delka\" gl_pam_hodnoty)
          gl_pam_hodnoty
        ))"
    )
    (action_tile "sirka"
	"(setq gl_pam_hodnoty
        (subst
          (cons \"sirka\" $value)
          (assoc \"sirka\" gl_pam_hodnoty)
          gl_pam_hodnoty
        ))"
    )
    (action_tile "vyska"
	"(setq gl_pam_hodnoty
        (subst
          (cons \"vyska\" $value)
          (assoc \"vyska\" gl_pam_hodnoty)
          gl_pam_hodnoty
        ))"
    )
		;;; je-li změněn některý editbox nastav hodnoty

    (action_tile "stred_but" "(done_dialog 4)")
		;;; je-li zmáčknuto tlačítko "stred_but" zavolej
    		;;; funkci done_dialog s hodnotou 4
    (action_tile "accept" "(done_dialog 1)")
		;;; je-li zmáčknuto tlačítko "accept"
    		;;; zavolej funkci done_dialog s hodnotou 1
    (action_tile "cancel" "(done_dialog 0)")
		;;; je-li zmáčknuto tlačítko "cancel"
    		;;; zavolej funkci done_dialog s hodnotou 0
  
    (setq co_delat (start_dialog))
		;;; nastaví proměnnou na hodnotu získanou od funkce start_dialog
		;;; (hodnota s kterou končí funkce done_dialog)
    (cond	;;; určení další činnosti
      ((= co_delat 0) (setq vysledek nil))	;;; uživatel stornoval dialog = konec funce
      ((= co_delat 1) (setq vysledek T))	;;; uživatel potvrdil dialog,
      						;;; zavolej funkci (vykresli)
      ((= co_delat 4) (rb:nastav_stred (getpoint "\nVýběr bodu:")))
			;;; uživatel zmáčkl tlačítko pro zadání souřadnic středu
	    		;; zavolej funkci rb:nastav_stred
    )
  )
  (unload_dialog id)	;;; odstraní dialog id z paměti
    vysledek		;;; vrácení výsledku funkce (jestli proběhla OK)
)

(defun rb:nastav_stred (stred / stredx stredy stredz)
  (setq stredx (strcat (vl-princ-to-string (car stred))))
  (setq stredy (strcat (vl-princ-to-string (cadr stred))))
  (setq stredz (strcat (vl-princ-to-string (caddr stred))))

  (setq gl_pam_hodnoty
    (subst
	(cons  "stredx" stredx)
        (assoc "stredx" gl_pam_hodnoty)
	gl_pam_hodnoty
    )
  )
  (setq gl_pam_hodnoty
    (subst
	(cons  "stredy" stredy)
        (assoc "stredy" gl_pam_hodnoty)
	gl_pam_hodnoty
    )
  )
  (setq gl_pam_hodnoty
    (subst
        (cons  "stredz" stredz)
        (assoc "stredz" gl_pam_hodnoty)
        gl_pam_hodnoty
    )
  )
)

(defun rb:kresli_box (/ stred delka vyska sirka)
  (setq acadObjekt (vlax-get-acad-object)) 
  (setq acadDokument (vla-get-ActiveDocument acadObjekt))
  (setq modelProstor (vla-get-ModelSpace acadDokument)) 

  (setq stred
    (list
      (atof (cdr (assoc "stredx" gl_pam_hodnoty)))
      (atof (cdr (assoc "stredy" gl_pam_hodnoty)))
      (atof (cdr (assoc "stredz" gl_pam_hodnoty)))
    )
  )		;;; převod tří řetězců reprezentujících souřadnice
  		;;; do proměnné stred (položky stred jsou typu float)
  (setq delka (atof (cdr (assoc "delka" gl_pam_hodnoty))))
		;;; získání délky krychle z asoc. seznamu gl_pam_hodnoty  
  (setq sirka (atof (cdr (assoc "sirka" gl_pam_hodnoty))))
		;;; získání sirka krychle z asoc. seznamu gl_pam_hodnoty  
  (setq vyska (atof (cdr (assoc "vyska" gl_pam_hodnoty))))
		;;; získání vyska krychle z asoc. seznamu gl_pam_hodnoty  

  (command)	;;; ukončení všech předchozích příkazů
  (setq objBox
	(vla-addBox modelProstor
		 (vlax-3d-point stred) delka sirka vyska
	)
  )

  (setq objemPuvodni (vla-get-volume objBox))
  (setq boxReaktor (vlr-object-reactor (list objBox)
     objemPuvodni '((:vlr-modified . infoBox)))
  )
  (command "_zoom" "M")
)

(princ "\nFunkce se spustí příkazem (c:reaktorBox) v IDE Visual LISPu")
(princ "\nFunkce se spustí příkazem reaktorBox v AutoCADu")