FORCER LA COULEUR DES CALQUES DANS LES FENETRES DE PRESENTATION

[PHILPHIL]

HELLO

voici un lisp pour forcer la couleur des calques dans les fenetres de présentations sans les ouvrir.

merci a Gile au passage.

ca ouvre une fenêtre pour choisir les fenestres a modifier, ( repérer grâce a leurs ID ), puis une fenetre de filtre de calque, puis une fenetre de sélection des calques, puis sélection de la couleurs désirée.

bizarrement sans aller dans les présentations , les ID des fenetres sont toutes à "0", une fois avoir parcourues les présentations, l'ID change et passe à "2" ( minimum).

qui a la solution pour ne pas a avoir ce souci ?

A+

Phil

 

(defun c:change_couleur_des_calques_dans_fenetres (/ acdoc ss ref name new)
  (setq cav (getvar "clayer"))
  (command-s "-calque" "ch" "0" "")
  (setq couleur (atoi (getcfg "APPDATA/couleur")))
  (setq selectfen nil
        listefen nil
        listobj nil
        lists1 nil
        compt 0
  )
  (setq selectfen (ssget "X" '((0 . "VIEWPORT") (-4 . "<NOT") (69 . 1) (-4 . "NOT>"))))
  (setq com (sslength selectfen))
  (while (< compt com)
    (progn (setq obj      (ssname selectfen compt)
                 listobj  (cons obj listobj)
                 pre_name (cdr (assoc 410 (entget obj)))
                 id_fen   (cdr (assoc 69 (entget obj)))
                 li1      (strcat pre_name (rtos id_fen 2 0))
           )
           (setq listefen (cons li1 listefen))
    )
    (setq compt (1+ compt))
  )
  (setq viewport1 (getlviewport1 listefen "CHOSISSEZ LES FENETRES A MODIFIER" t))
  (setq comlistefen (length listefen))
  (foreach ele viewport1
    (progn (setq lists1 (cons (- comlistefen (length (member ele listefen))) lists1)))
  )
  (setq lists1 (reverse lists1))
  (setq nomlayerfiltre (getcfg "APPDATA/NOMLAYERFILTRE"))
  (setq boite "FILTRE DES CALQUES      [ * ]  POUR FILTRER AUCUN CALQUES ")
  (setq message "LE(S) CARACTERE(S) A FILTRER DANS LE NOM")
  (inputbox2 boite message nomlayerfiltre)
  (if (/= ret "")
    (setq nomlayerfiltre ret)
  )
  (setcfg "APPDATA/NOMLAYERFILTRE" nomlayerfiltre)
  (setq layers (getlayers_filtre_double nil t))
;;;  (setq layers (getlayers_filtre nil t))
  (setq couleurnew (acad_colordlg 1))
  (setcfg "APPDATA/couleur" (rtos couleurnew 2 0))
  (foreach l1 lists1
    (progn (setq viewport (nth l1 listobj))
           (foreach lay layers (gc-vplayeroverride viewport lay couleurnew nil -3))
    )
  )
  (setvar "clayer" cav)
  (princ)
)

 

(defun c:change_couleur_des_calques_annuler_dans_fenetres (/ acdoc ss ref name new)
  (setq cav (getvar "clayer"))
  (command-s "-calque" "ch" "0" "")
  (setq couleur (atoi (getcfg "APPDATA/couleur")))
  (setq selectfen nil
        listefen nil
        listobj nil
        lists1 nil
        compt 0
  )
  (setq selectfen (ssget "X" '((0 . "VIEWPORT") (-4 . "<NOT") (69 . 1) (-4 . "NOT>"))))
  (setq com (sslength selectfen))
  (while (< compt com)
    (progn (setq obj      (ssname selectfen compt)
                 listobj  (cons obj listobj)
                 pre_name (cdr (assoc 410 (entget obj)))
                 id_fen   (cdr (assoc 69 (entget obj)))
                 li1      (strcat pre_name (rtos id_fen 2 0))
           )
           (setq listefen (cons li1 listefen))
    )
    (setq compt (1+ compt))
  )
  (setq viewport1 (getlviewport1 listefen "CHOSISSEZ LES FENETRES A MODIFIER" t))
  (setq comlistefen (length listefen))
  (foreach ele viewport1
    (progn (setq lists1 (cons (- comlistefen (length (member ele listefen))) lists1)))
  )
  (setq lists1 (reverse lists1))
  (setq layers (getlayers_filtre nil t))
  (foreach l1 lists1
    (progn (setq viewport (nth l1 listobj)) (foreach lay layers (gc-vplayerremoveall viewport lay)))
  )
  (setvar "clayer" cav)
  (princ)
)

 

(defun c:ID_FENETRE (/ acdoc ss ref name new)
  (setq cav (getvar "clayer"))
  (setq txtech 1)
  (setq techl 0.01); je travaille en centimetre
(if (= (tblsearch "layer" "T_ID_CENTRE FENETRE") nil)
    (command-s "-calque" "n" "T_ID_CENTRE FENETRE" "co" "137" "T_ID_CENTRE FENETRE" "")
  )
(command-s "-calque" "ch" "T_ID_CENTRE FENETRE" "")

  (setq selectfen nil
        listefen nil
        listobj nil
        lists1 nil
        id_fen nil
        compt 0
  )
  (setq selectfen (ssget '((0 . "VIEWPORT") (-4 . "<NOT") (69 . 1) (-4 . "NOT>"))))
  (setq com (sslength selectfen))
  (while (< compt com)
    (progn (setq obj      (ssname selectfen compt)
                 listobj  (cons obj listobj)
                 pre_name (cdr (assoc 410 (entget obj)))
                 center1 (cdr (assoc 10 (entget obj)))
                 id_fen   (cdr (assoc 69 (entget obj)))
           )
(command-s "TEXTE" "st" "arial" "j" "mc" center1 (rtos (/ (* 1.5 txtech) techl) 2 8) "" (rtos id_fen 2 0))
   )
    (setq compt (1+ compt))
  )
  (setvar "clayer" cav)
  (princ)
)

 

;; (gile) 03/12/07
;; Retourne la liste des présentations choisies dans la boite de dialogue
;;
;; arguments
;; titre : titre de la boite de dialogue ou nil, défauts = Choisir la (ou les) présentation(s)
;; mult : T ou nil (pour choix multiple ou unique)

(defun getlviewport1 (listefen titre mult / tmp file ret)


  (setq tmp  (vl-filename-mktemp "tmp.dcl")
        file (open tmp "w")
  )
    (write-line (strcat "getlviewport1:dialog{label="
                      (if titre
                        (vl-prin1-to-string titre)
                        (if mult
                          "\"Choisir les présentations du fichier\""
                          "\"Choisir une présentation\""
                        )
                      )
                      ";:list_box{height = 50;key=\"lst\";multiple_select="
                      (if mult
                        "true;width = 100;}:row{:retirement_button{label=\"Toutes\";key=\"all\";}
ok_button;cancel_button;}}"
                        "false;}ok_cancel;}"
                      )
              )
              file
  )
  (close file)
  (setq dcl_id (load_dialog tmp))
  (if (not (new_dialog "getlviewport1" dcl_id))
    (exit)
  )
  (start_list "lst")
  (mapcar 'add_list listefen)
  (end_list)
  (action_tile "all" "(setq ret (reverse listefen)) (done_dialog)")
  (action_tile "accept"
               "(or (= (get_tile \"lst\") \"\")
(foreach n (str2lst (get_tile \"lst\") \" \")
(setq ret (cons (nth (atoi n) listefen) ret))))
(done_dialog)"
  )
  (start_dialog)
  (unload_dialog dcl_id)
  (vl-file-delete tmp)
  (reverse ret)
)

;; InputBox (gile)
;; Ouvre une boite de dialogue pour récupérer une valeur
;; sous forme de chaine de caractère
;;
;; Arguments
;; tous les arguments sont de chaines de caractère (ou "")
;; box : titre de la boite de dialogue
;; msg : message d'invite
;; val : valeur par défaut
;;
;; Retour
;; une chaine ("" si annulation)
;;
;; Modifié par Patrick_35 pour inclure le caractère \n
;; comme retour chariot

(defun inputbox2 (box msg val / subr temp file dcl_id
                                               ;;ret
) ;; Retour chariot automatique à 50 caractères
  (defun subr (str / pos)
    (cond ((setq pos (vl-string-search "\n" str))
           (strcat ":text_part{label=\"" (substr str 1 pos) "\";}" (subr (substr str (+ 2 pos))))
          )
          ((and (< 80 (strlen str)) (setq pos (vl-string-position 32 (substr str 1 80) nil t)))
           (strcat ":text_part{label=\"" (substr str 1 pos) "\";}" (subr (substr str (+ 2 pos))))
          )
          (t (strcat ":text_part{label=\"" str "\";}"))
    )
  )
  ;; Créer un fichier DCL temporaire
  (setq temp (vl-filename-mktemp "Tmp.dcl")
        file (open temp "w")
        ret  ""
  )
  ;; Ecrire le fichier
  (write-line (strcat "InputBox:dialog{key=\"box\";initial_focus=\"val\";spacer;:paragraph{"
                      (subr msg)
                      "}spacer;:edit_box{key=\"val\";edit_width=120;allow_accept=true;}
    spacer;ok_cancel;}"
              )
              file
  )
  (close file)
  ;; Ouvrir la boite de dialogue
  (setq dcl_id (load_dialog temp))
  (if (not (new_dialog "InputBox" dcl_id))
    (exit)
  )
  (set_tile "box" box)
  (set_tile "val" val)
  (action_tile "accept" "(setq ret (get_tile \"val\")) (done_dialog)")
  (start_dialog)
  (unload_dialog dcl_id)
  ;;Supprimer le fichier
  (vl-file-delete temp)
  ret
)

 

(defun getlayers_filtre_double (titre mult / lay layers tmp file ret)
  (while (setq lay (tblnext "LAYER" (not lay))) (setq layers (cons (cdr (assoc 2 lay)) layers)))
  (setq layerfiltre nil)
  (foreach layer layers
    (if (wcmatch layer (strcat "*" nomlayerfiltre "*"))
      (setq layerfiltre (cons layer layerfiltre))
    )
  )
  (setq layers (vl-remove-if '(lambda (x) (member x '("0" "Defpoints" "DEFPOINTS" "Ashade" "ASHADE"))) layerfiltre))
  (setq layers (vl-sort layers '<)
        tmp    (vl-filename-mktemp "tmp.dcl")
        file   (open tmp "w")
  )
  (write-line (strcat "getlayers:dialog{label="
                      (if titre
                        (vl-prin1-to-string titre)
                        (if mult
                          "\"Choisir les calques du fichier\""
                          "\"Choisir un calque\""
                        )
                      )
                      ";:list_box{height = 50;width = 100;key=\"lst\";multiple_select="
                      (if mult
                        "true;width = 200;}:row{:retirement_button{label=\"Toutes\";key=\"all\";}
ok_button;cancel_button;}}"
                        "false;}ok_cancel;}"
                      )
              )
              file
  )
  (close file)
  (setq dcl_id (load_dialog tmp))
  (if (not (new_dialog "getlayers" dcl_id))
    (exit)
  )
  (start_list "lst")
  (mapcar 'add_list layers)
  (end_list)
  (action_tile "all" "(setq ret (reverse layers)) (done_dialog)")
  (action_tile "accept"
               "(or (= (get_tile \"lst\") \"\")
(foreach n (str2lst (get_tile \"lst\") \" \")
(setq ret (cons (nth (atoi n) layers) ret))))
(done_dialog)"
  )
  (start_dialog)
  (unload_dialog dcl_id)
  (vl-file-delete tmp)
  (reverse ret)
)