(vl-load-com)		;;; provede se hned při nahrání funkce

(defun  rk:zmenKruh(volajObj reactorObj paramList / objVyplne pomocna polomer stred_kr pocet
		 vzdalenost pol_kresl)
  (if (vlax-property-available-p volajObj "Radius")
   (progn
    (setq objVyplne (vlr-data reactorObj))
    (while (> (length objVyplne) 0)
      (setq pomocna (cdr objVyplne))
      (vla-delete (car objVyplne))
      (setq objVyplne pomocna)
    )
    (setq objVyplne nil)
    (setq polomer (vla-get-radius volajObj))
    (setq stred_kr (vla-get-center volajObj))
    (setq pocet 1)   ;;; získání počtu kreslených kružnic z asoc. seznamu gl_pam_hodnoty
    (setq vzdalenost (atof (cdr (assoc "vzdalenostke" gl_pam_hodnoty))))
    (while (> polomer (* vzdalenost pocet))	;;; dokud je co kreslit opakuj
      (setq pol_kresl (* vzdalenost pocet))	;;; nastav aktuální poloměr
      (setq objVyplne
       (cons 
        (vla-addCircle modelProstor stred_kr pol_kresl)
         objVyplne
        )
       )
      (setq pocet (+ pocet 1))					;;; zmenši počet kružnic o 1
    )
    (vlr-data-set reactorObj objVyplne)
   )
  )
)

(defun rk:vypisInformaci (volajiciReaktor informace / jmenoSouboru velikost)
    (vl-load-com)
    (setq jmenoSouboru (cadr informace)
        velikost (vl-file-size jmenoSouboru)
  )
  (alert (strcat "Velikost uloženého souboru " jmenoSouboru " je "
                 (itoa velikost) " byt;."
          )
  )
  (princ)
)

(defun c:reaktorKruh ()
;;; definice nové funkce kresli
;  (vlr-remove-all :vlr-object-reactor :vlr-dwg-reactor)
  (setq	gl_pam_hodnoty		;;; globální proměnná uchovávající jednotlivá nastavení
     (list
	(cons "stredkex"     "0.0")	;;; x-ova souřadnice středu soustř. kružnic
	(cons "stredkey"     "0.0")	;;; y-ova souřadnice středu soustř. kružnic
	(cons "stredkez"     "0.0")	;;; z-ova souřadnice středu soustř. kružnic
	(cons "polomerke"    "1")		;;; poloměr kružnice (editbox)
	(cons "polomerks"    "1")		;;; poloměr kružnice (slider)
	(cons "vzdalenostke" "1")		;;; vzdálenost mezi kružnicemi (editbox)
	(cons "vzdalenostks" "1")		;;; vzdálenost mezi kružnicemi (slider)
	(cons "kruz_stred_but"  "0")	;;; tlačítko - stred kruznice
     )
  )

  (if	(= (rk:dialog) T)
    (so:kresli_kruznici)			;;; vykreslení požadovaného objektu,
      									;;; v případě že byly zadány hodnoty  
  )
  (vlr-dwg-reactor nil '((:vlr-saveComplete . rk:vypisInformaci)))
  (princ "Funkce reaktor kruh dokončila činnost")	;;; informace o ukončení funkce
  (princ)
)

 
(defun rk:dialog (/ id co_delat vysledek)
  (setq id (load_dialog "D:/dialogKruh.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 "dialogKruh" id))		;;; není-li jméno dialogu vyber tak skonči
      (exit)
    )
    ;;; nastavení hodnot dialogových prvků
    (set_tile "polomerke"    (cdr (assoc "polomerke"    gl_pam_hodnoty)))
    (set_tile "polomerks"    (cdr (assoc "polomerks"    gl_pam_hodnoty)))
    (set_tile "vzdalenostke" (cdr (assoc "vzdalenostke" gl_pam_hodnoty)))
    (set_tile "vzdalenostks" (cdr (assoc "vzdalenostks" gl_pam_hodnoty)))
    (set_tile "stredkex"     (cdr (assoc "stredkex"     gl_pam_hodnoty)))
    (set_tile "stredkey"     (cdr (assoc "stredkey"     gl_pam_hodnoty)))
    (set_tile "stredkez"     (cdr (assoc "stredkez"     gl_pam_hodnoty)))

    (action_tile "polomerks" "(so:vazba_prvku $value $reason \"polomerke\"  \"polomerks\")")
    (action_tile "vzdalenostks"	"(so:vazba_prvku $value $reason \"vzdalenostke\" \"vzdalenostks\")")
		;;; je-li změněn některý posuvník "slider.." zavolej funkci so:vazba_prvků
    (action_tile "stredkex"
       "(setq gl_pam_hodnoty
        (subst
          (cons \"stredkex\" $value)
          (assoc \"stredkex\" gl_pam_hodnoty)
          gl_pam_hodnoty
        ))"
    )
    (action_tile "stredkey"
       "(setq gl_pam_hodnoty
        (subst
          (cons \"stredkey\" $value)
          (assoc \"stredkey\" gl_pam_hodnoty)
          gl_pam_hodnoty
        ))"
    )
    (action_tile "stredkez"
       "(setq gl_pam_hodnoty
        (subst
          (cons \"stredkez\" $value)
          (assoc \"stredkez\" 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 "polomerke" "(so:vazba_prvku $value $reason \"polomerke\" \"polomerks\")")
    (action_tile "vzdalenostke"	"(so:vazba_prvku $value $reason \"vzdalenostke\" \"vzdalenostks\")")
		;;; je-li změněn některý editbox zavolej funkci so:vazba_prvku

    (action_tile "kruz_stred_but" "(done_dialog 4)")
		;;; je-li zmáčknuto tlačítko "kruz_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) (so:nastav_stred (getpoint "\nVýběr bodu:")))
				;;; uživatel zmáčkl tlačítko pro zadání souřadnic středu
	    			;; zavolej funkci nastav_střed
    )
  )
  (unload_dialog id)		;;; odstraní dialog id z paměti
    vysledek			;;; vrácení výsledku funkce (jestli proběhla OK)
)

(defun so: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  "stredkex" stredx)
        (assoc "stredkex" gl_pam_hodnoty)
	gl_pam_hodnoty
    )
  )
  (setq gl_pam_hodnoty
    (subst
	(cons  "stredkey" stredy)
        (assoc "stredkey" gl_pam_hodnoty)
	gl_pam_hodnoty
    )
  )
  (setq gl_pam_hodnoty
    (subst
        (cons  "stredkez" stredz)
        (assoc "stredkez" gl_pam_hodnoty)
        gl_pam_hodnoty
    )
  )
)

(defun so:kresli_kruznici (/ stred_kr polomer pol_kresl pocet vzdalenost objektyVyplne)
  (setq acadObjekt (vlax-get-acad-object)) 
  (setq acadDokument (vla-get-ActiveDocument acadObjekt))
  (setq modelProstor (vla-get-ModelSpace acadDokument)) 

  (setq stred_kr
    (list
      (atof (cdr (assoc "stredkex" gl_pam_hodnoty)))
      (atof (cdr (assoc "stredkey" gl_pam_hodnoty)))
      (atof (cdr (assoc "stredkez" gl_pam_hodnoty)))
    )
  )		;;; převod tří řetězců reprezentujících souřadnice
  		;;; do proměnné stred (položky stred jsou typu float)
  (setq polomer (atof (cdr (assoc "polomerke" gl_pam_hodnoty))))
		;;; získání poloměru první kružnice z asoc. seznamu gl_pam_hodnoty  
  (setq vzdalenost (atof (cdr (assoc "vzdalenostke" gl_pam_hodnoty))))
		;;; získání vzdálenosti mezi kružnicemi z asoc. seznamu gl_pam_hodnoty
  (setq pocet 1)
		;;; získání počtu kreslených kružnic z asoc. seznamu gl_pam_hodnoty

  (command)	;;; ukončení všech předchozích příkazů
  (setq objektyVyplne nil)
  (while (> polomer (* vzdalenost pocet))	;;; dokud je co kreslit opakuj
    (setq pol_kresl (* vzdalenost pocet))	;;; nastav aktuální poloměr
    (setq objektyVyplne
      (cons 
        (vla-addCircle modelProstor (vlax-3d-point stred_kr) pol_kresl)
         objektyVyplne
      )
    )
    (setq pocet (+ pocet 1))					;;; zmenši počet kružnic o 1
  )

  (setq hranicniKruh
   (vla-addCircle modelProstor
    (vlax-3d-point stred_kr) polomer
   )
  )

  
  (setq kruhReaktor   (vlr-object-reactor (list hranicniKruh)
	   objektyVyplne '((:vlr-modified . rk:zmenKruh))))
  (command "_zoom" "M")  
)

(defun so:vazba_prvku (val why editbox slider)
  (if (or (= why 2) (= why 1))
;;; zjistení jaká akce uživatele způsobila akci dialogu
;;; 2 = opustění editboxu
;;; 1 = uživatel vybral prvek (příklad entrem)
    (progn
      (setq edit_hodnota (atof val))
;;; převedení řetězce reprezentujícího nastavenou hodnotu   na číslo
      (if (> edit_hodnota 5000)
	(setq val "5000")	;;; je-li číslo mimo rozsah prvku, proveď korekci
      )
      (if (< edit_hodnota 0)
	(setq val "0")		;;; je-li číslo mimo rozsah prvku, proveď korekci
      )
      (set_tile editbox val)	;;; nastavení editboxu na správnou hodnotu
      (set_tile slider val)	;;; nastavení slideru na správnou hodnotu
      (setq gl_pam_hodnoty
	(subst
	  (cons editbox val)
	  (assoc editbox gl_pam_hodnoty)
	  gl_pam_hodnoty
	)
      )
      (setq gl_pam_hodnoty
	(subst
	  (cons slider val)
	  (assoc slider gl_pam_hodnoty)
	  gl_pam_hodnoty
	)
      )
    )
  )
)

;;; nakonec zobrazíme informaci pro uživatele, jak má spustit funkci
(princ "\nNezapomeňte nastavit správnou cestu k dialogu ve funkci rk:dialog!!!")
(princ "\nFunkce se spouští příkazem  (c:reaktorKruh) v IDE Visual LISPu")
(princ "\nFunkce se spouští příkazem  reaktorKruh v AutoCADu")