;;--------------------------------------------------------------------------*
;;  Copyright 20099  DC4 Technisches Büro GmbH                               *
;;                                                                          *
;;--------------------------------------------------------------------------*
;;  Dateiname: schreibweise.lsp
;;  Version  : 1.0
;;  Datum    : 13.11.2009
;;  Author   : Gt
;;--------------------------------------------------------------------------*

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

;;--------------------------------------------------------------------------*
;;     dialogs                                                              *
;;--------------------------------------------------------------------------*

(sd-defdialog 'dc4-namen-verschoenern-dialog
:dialog-title "Schreibweise Namen"
;;:dialog-control :sequential
:variables
  '(
    (teil_bgr  :selection
              (*sd-assembly-seltype* *sd-part-seltype*)
           :multiple-items t
           :show-select-menu t
           :prompt-text "Teile oder Baugruppe angeben"
           :title "Teil/Bgr"
           :modifies :instance
           ;;:initial-value nil
    )
				("Textformat Teilename")
    (bfl   :value-type :grouped-boolean
           :title "Name"
           :size :third
           :initial-value t
    )
    (upc   :value-type :grouped-boolean
           :title "NAME"
           :size :third
           :initial-value nil
    )
    (lwc    :value-type :grouped-boolean
           :title "name"
           :size :third
           :initial-value nil
    )
    (next  :title "Umformen"
           :push-action (sd-call-cmds (next-action))
           :next-variable 'bgr
    )
   )
:mutual-exclusion '(bfl upc lwc)
:local-functions
  '(
    (next-action ()
     (let (selit teilitem pfadalt namealt nameneu obg err)
      (dolist (selit teil_bgr)
       (setf namealt (sd-inq-obj-basename selit))
;;(display (format nil "Namealt= ~a" namealt))
							(cond
								(bfl (setf nameneu (string-capitalize namealt)))
								(upc (setf nameneu (string-upcase namealt)))
								(lwc (setf nameneu (string-downcase namealt)))
							);;cond
       (sd-call-cmds (CHANGE_NAME_PA :PART_ASMB selit :NAME nameneu))
      );;dolist
     );;let
    )
   )
:ok-action
   '()
)

;;--------------------------------------------------------------------------*