; Dieses Makro wird nicht supportet!
; Fragen und Hinweise zum Makro bitte direkt an den Ersteller (s.u.)
; Grundfarbe allen Teilen einer Baugruppen in einer Oberbaugruppe
; oder ausgewaehlten Teilen nach dem Zufallsprinzip neu vergeben
; Erstellt:  September 2004, Christian Ernst, ASCAD Chemnitz
; Ueberarbeitet: August 2007
; Geändert:  November 2007, Ronny Witt, SAMAG Saalfeld
; Dateiname: SD_Teilefarbe_neu.lsp

(in-package  :CHER)
(use-package :OLI)

; ü=Ï ; ä=Ì ; ö=?? ; Ü=Û ; Ä=Ø ; Ö=Ú ; Ø=Ò; µ=ó



(sd-defdialog 'cher_farbe_aendern
  :dialog-title "T/BG umfÌrben"
  :variables
    '(
       (obj		    :selection (*sd-object-seltype*)
					:multiple-items t
                    :prompt-text "Bitte Teil oder Baugruppe auswÌhlen"
                    :title       "Teil(e)/BG(n)"
       )
      ("Farbe vergeben")
      (grundfarbe_vergeben :value-type    :grouped-boolean
                           :title         "Basis"
                           :initial-value T
      )
      (exemplarfarbe_vergeben :value-type    :grouped-boolean
                              :title         "Exemplar"
                              :initial-value NIL
      )
      ("Farbe entfernen")
      (grundfarbe_entfernen :value-type    :grouped-boolean
                            :title         "Basis"
                            :initial-value NIL
      )
      (exemplarfarbe_entfernen :value-type    :grouped-boolean
                               :title         "Exemplar"
                               :initial-value T
      )
   )
   :local-functions
   '(
      (faerben (obj)
		(dolist (elem obj)
			(setf teiletyp (sel_item-type elem))
			(if (equal teiletyp *sd-part-seltype*)
			  (progn
				(if grundfarbe_vergeben
					(part_prop elem :BASE_COLOR (random 16000000))
				)
				(if exemplarfarbe_vergeben
					(part_prop elem :COLOR (random 16000000))
				)
				(if grundfarbe_entfernen
					(part_prop elem :BASE_COLOR :OFF)
				)
				(if exemplarfarbe_entfernen
					(part_prop elem :COLOR :OFF)
				)
			  ) ; end progn
			(when (equal teiletyp *sd-assembly-seltype*)
				(progn
				(setf sohn (sd-inq-obj-children elem))			
				(faerben sohn)
				) ; end progn
			); end when
			); end if
		);end dolist			
      ); end faerben

    ); end local-functions

   :ok-action '(faerben obj)

) ; end sd-defdialog

;....................................................................;