;;; - ------------------------------------------------------------------------------ - ;
;;; -         B I B O - A C A D P R O F I L E                                        - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Autor  : Th.Krüger                                                             - ;                                                   - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Enthält Routinen zur Manipulation von ACAD-Profilen...Vertikal-Produkte sind   - ;
;;; - bei PROFILIMPORT/EXPORT mit Vorsicht zu genießen                               - ;
;;; - ------------------------------------------------------------------------------ - ;
;;;   DT:PROFILE-LIST
;;;   DT:PROFILE-AKTIV-GET
;;;   DT:PROFILE-AKTIV-SET
;;;   DT:PROFILE-RENAME
;;;   DT:PROFILE-COPY
;;;   DT:PROFILE-DELETE
;;;   DT:PROFILE-EXPORT
;;;   DT:PROFILE-IMPORT
;;;   DT:PROFILE-UPDATE
(vl-load-com)
;;; - ---### Benötigte Tool-Routinen  ########################################## --- - ;

;;; - ------------------------------------------------------------------------------ - ;
;;; - Funktionsname : DT:PROFILE-LIST                                                - ;
;;; - Beschreibung  : Gibt die Namen aller verfügbaren ACAD-Profile zurück           - ;
;;; - Parameter     : Keine                                                          - ;
;;; - Rückgabe      : PROFILNAMENLISTE [List (String)]                               - ;
;;; - Beispiel      : (DT:PROFILE-LIST)                                              - ;
;;; - ------------------------------------------------------------------------------ - ;
(defun DT:PROFILE-LIST ( / PNAMES)
  (vla-GetAllProfileNames
    (vla-get-profiles(vla-get-preferences(vlax-get-Acad-Object)))
    'PNAMES
  )
  (mapcar '(lambda(X) (strcase X))(vlax-safearray->list PNAMES))  
)  
;;; - ------------------------------------------------------------------------------ - ;

;;; - ------------------------------------------------------------------------------ - ;
;;; - Funktionsname : DT:PROFILE-AKTIV-GET                                           - ;
;;; - Beschreibung  : Gibt die Namen des aktuellen ACAD-Profiles zurück              - ;
;;; - Parameter     : Keine                                                          - ;
;;; - Rückgabe      : PROFILNAME [String]                                            - ;
;;; - Beispiel      : (DT:PROFILE-AKTIV-GET)                                         - ;
;;; - ------------------------------------------------------------------------------ - ;
(defun DT:PROFILE-AKTIV-GET()
  (strcase(vlax-get-property    
            (vla-get-profiles(vla-get-preferences(vlax-get-Acad-Object)))
            'ActiveProfile
          )
  )
)  
;;; - ------------------------------------------------------------------------------ - ;

;;; - ------------------------------------------------------------------------------ - ;
;;; - Funktionsname : DT:PROFILE-AKTIV-SET                                           - ;
;;; - Beschreibung  : Setzt das Profil mit dem übergebenen Namen  aktuell            - ;
;;; - Parameter     : PROFILNAME [String]                                            - ;
;;; - Rückgabe      : bei Erfolg :  'T                                               - ;
;;; -                 bei Fehler : nil                                               - ;
;;; - Beispiel      : (DT:PROFILE-AKTIV-SET (car(DT:PROFILE-LIST)))                  - ;
;;; - ------------------------------------------------------------------------------ - ;
(defun DT:PROFILE-AKTIV-SET ( PROFILNAME / PROFILES PNAMES)
  (setq PROFILES(vla-get-profiles(vla-get-preferences(vlax-get-Acad-Object))))
  (vla-GetAllProfileNames PROFILES 'PNAMES)  
  (and(=(type PROFILNAME) 'STR)
      (member(strcase PROFILNAME)
             (mapcar '(lambda(X) (strcase X))(vlax-safearray->list PNAMES))
      )
      (not(vl-catch-all-error-p                 
            (vl-catch-all-apply 'vla-put-ActiveProfile (list PROFILES PROFILNAME))
          )
      )    
      (=(strcase PROFILNAME)
        (strcase(vla-get-activeprofile  PROFILES))
      )                
  )
)  
;;; - ------------------------------------------------------------------------------ - ;


;;; - ------------------------------------------------------------------------------ - ;
;;; - Funktionsname : DT:PROFILE-RENAME                                              - ;
;;; - Beschreibung  : Benennt Profil mit dem übergebenen Namen auf neuen Namen um    - ;
;;; - Parameter     : PROFILNAME [String]                                            - ;
;;; -                 NEUERNAME  [String]                                            - ;
;;; - Rückgabe      : bei Erfolg :  'T                                               - ;
;;; -                 bei Fehler : nil                                               - ;
;;; - Beispiel      : (DT:PROFILE-RENAME "KE-TKS" "KE-TKS-NEU")                      - ;
;;; - ------------------------------------------------------------------------------ - ;
(defun DT:PROFILE-RENAME (PROFILNAME NEUERNAME)
  (and(=(type PROFILNAME)'STR)(=(type NEUERNAME)'STR)
      (not(vl-catch-all-error-p
            (vl-catch-all-apply       
              'vla-RenameProfile
              (list(vla-get-profiles(vla-get-preferences(vlax-get-Acad-Object)))
                   PROFILNAME NEUERNAME
              )
            )
          )
      )    
  )
)
;;; - ------------------------------------------------------------------------------ - ;

;;; - ------------------------------------------------------------------------------ - ;
;;; - Funktionsname : DT:PROFILE-COPY                                                - ;
;;; - Beschreibung  : Erstellt eine Kopie vom Profil mit dem übergebenen Namen unter - ;
;;; -                 neuem Namen                                                    - ;
;;; - Parameter     : PROFILNAME [String]                                            - ;
;;; -                 NEUERNAME  [String]                                            - ;
;;; - Rückgabe      : bei Erfolg :  'T                                               - ;
;;; -                 bei Fehler : nil                                               - ;
;;; - Beispiel      : (DT:PROFILE-COPY "KE-TKS" "KE-TKS-COPY")                       - ;
;;; - ------------------------------------------------------------------------------ - ;
(defun DT:PROFILE-COPY (PROFILNAME NEUERNAME)
  (and(=(type PROFILNAME)'STR)(=(type NEUERNAME)'STR)
      (not(vl-catch-all-error-p
            (vl-catch-all-apply       
              'vla-CopyProfile
              (list(vla-get-profiles(vla-get-preferences(vlax-get-Acad-Object)))
                   PROFILNAME  NEUERNAME
              )
            )
          )
      )        
  )
)
;;; - ------------------------------------------------------------------------------ - ;


;;; - ------------------------------------------------------------------------------ - ;
;;; - Funktionsname : DT:PROFILE-DELETE                                              - ;
;;; - Beschreibung  : Löscht das Profil mit dem übergebenen Namen aus der Registry   - ;
;;; - Parameter     : PROFILNAME [String]                                            - ;
;;; - Rückgabe      : bei anschließendem Nichtvorhandensein des Profils :  'T        - ;
;;; -                 sonst : nil                                                    - ;
;;; - Beispiel      : (DT:PROFILE-DELETE "KE-TKS-COPY")                              - ;
;;; - ------------------------------------------------------------------------------ - ;
(defun DT:PROFILE-DELETE(PROFILNAME / PNAMES)
  (vla-GetAllProfileNames
    (vla-get-profiles(vla-get-preferences(vlax-get-Acad-Object)))
    'PNAMES
  )
  (setq PNAMES(mapcar '(lambda(X) (strcase X))(vlax-safearray->list PNAMES)))
  (or(/=(type PROFILNAME)'STR)
     (not(member (strcase  PROFILNAME) PNAMES))
     (not(vl-catch-all-error-p
           (vl-catch-all-apply
             'vla-DeleteProfile
             (list(vla-get-profiles(vla-get-preferences(vlax-get-Acad-Object)))
                  PROFILNAME
             )
           )
         )
     )    
  )      
)  
;;; - ------------------------------------------------------------------------------ - ;

;;; - ------------------------------------------------------------------------------ - ;
;;; - Funktionsname : DT:PROFILE-EXPORT                                              - ;
;;; - Beschreibung  : Exportiert das Profil mit dem übergebenen Namen in eine Datei  - ;
;;; - Parameter     : PROFILNAME [String]                                            - ;
;;; -                 DATEINAME  [String]                                            - ;
;;; - Rückgabe      : bei Erfolg :  'T                                               - ;
;;; -                 bei Fehler : nil                                               - ;
;;; - ACHTUNG !!!!!!! Bei Vertikalprodukten wie Mechanical wird NUR das ACAD-Profil  - ;
;;; -                 exportiert die Mech-Einstellungen bleiben unberücksichtigt     - ;
;;; - Beispiel      : (DT:PROFILE-EXPORT "KE-TKS" "D:\\KE-TKS.ARG")                  - ;
;;; - ------------------------------------------------------------------------------ - ;
(defun DT:PROFILE-EXPORT (PROFILNAME DATEINAME / PNAMES)  
  (and(=(type PROFILNAME)'STR)(=(type DATEINAME)'STR)      
      (not(vl-catch-all-error-p
            (vl-catch-all-apply       
              'vla-ExportProfile
              (list(vla-get-profiles(vla-get-preferences(vlax-get-Acad-Object)))
                   PROFILNAME DATEINAME
              )     
            )
          )
      )
  )
)
;;; - ------------------------------------------------------------------------------ - ;

;;; - ------------------------------------------------------------------------------ - ;
;;; - Funktionsname : DT:PROFILE-IMPORT                                              - ;
;;; - Beschreibung  : Importiert das Profil aus der Datei mit dem übergebenen Namen  - ;
;;; - Parameter     : PROFILNAME [String]                                            - ;
;;; -                 DATEINAME  [String]                                            - ;
;;; - Rückgabe      : bei Erfolg :  'T                                               - ;
;;; -                 bei Fehler : nil                                               - ;
;;; - Beispiel      : (DT:PROFILE-IMPORT "KE-TKS" "D:\\KE-TKS.ARG")                  - ;
;;; - ------------------------------------------------------------------------------ - ;
(defun DT:PROFILE-IMPORT(PROFILNAME DATEINAME)
  (and(=(type PROFILNAME)'STR)(=(type DATEINAME)'STR)      
      (not(vl-catch-all-error-p
            (vl-catch-all-apply       
              'vla-ImportProfile
              (list(vla-get-profiles(vla-get-preferences(vlax-get-Acad-Object)))
                   PROFILNAME DATEINAME
                   :vlax-false
              )
            )
          )
      )
  )  
)
;;; - ------------------------------------------------------------------------------ - ;

;;; - ------------------------------------------------------------------------------ - ;
;;; - Funktionsname : DT:PROFILE-UPDATE                                              - ;
;;; - Beschreibung  : Ersetzt das aktuelle Profil durch ein aus der angegebenen      - ;
;;; -                 Datei geladenes                                                - ;
;;; - Parameter     : DATEI [String] - Dateiname                                     - ;
;;; - Rückgabe      : bei Erfolg : [STR] - Name des aktiven Profils                  - ;
;;; -                 bei Fehler : nil                                               - ;
;;; - Beispiel      : (DT:PROFILE-UPDATE  "D:\\KE-TKS.ARG" nil)                      - ;
;;; - ------------------------------------------------------------------------------ - ;
(defun DT:PROFILE-UPDATE(DATEI DELETE? / PNAMES PNAME TEMPNAME)
  (vla-GetAllProfileNames
    (vla-get-profiles(vla-get-preferences(vlax-get-Acad-Object)))
    'PNAMES
  )
  (setq PNAMES(mapcar '(lambda(X) (strcase X))(vlax-safearray->list PNAMES)))
  (and(=(type DATEI)'STR)
      (setq DATEI (findfile DATEI))
      (setq PNAME (strcase(vl-filename-base DATEI)))
      (or(not(member PNAME PNAMES))
         (progn           
           (setq NR 0)
           (while (member(setq TEMPNAME(strcat PNAME "-"(itoa(setq NR(1+ NR)))))PNAMES))
           (not(vl-catch-all-error-p
                 (vl-catch-all-apply       
                   'vla-RenameProfile
                   (list(vla-get-profiles(vla-get-preferences(vlax-get-Acad-Object)))
                        PNAME TEMPNAME
                   )
                 )
               )
           )    
         )
      )
      (not(vl-catch-all-error-p
            (vl-catch-all-apply       
              'vla-ImportProfile
              (list(vla-get-profiles(vla-get-preferences( vlax-get-Acad-Object)))
                   PNAME DATEI :vlax-false
              )
            )
          )
      )      
      (not(vl-catch-all-error-p
            (vl-catch-all-apply       
              'vla-put-ActiveProfile      
              (list(vla-get-profiles(vla-get-preferences(vlax-get-Acad-Object)))PNAME)
            )  
          )
      )
      (or(not TEMPNAME)
         (and DELETE?
              (not(vl-catch-all-error-p
                    (vl-catch-all-apply'vla-DeleteProfile(list TEMPNAME))
                  )
              )              
         )
         'T
      )      
  )
  (vla-get-activeprofile(vla-get-profiles(vla-get-preferences(vlax-get-Acad-Object))))
)
;;; - ------------------------------------------------------------------------------ - ;;